エクセル

質問

図形の中をクリックする度にとA～Gと変化するコードを以下にて作成しましたがA～Gではなく図形の中に7つの文字(確認要、手続き中など)を表記したいのですがマクロコードがうまくできません。ご教示願います。

Sub 四角形1_Click()
a = Array("", "A", "B", "C", "D", "E", "F", "G")

ActiveSheet.Shapes("Rectangle 1").Select
c = Selection.Characters.Text
If Left(c, 1) = a(UBound(a)) Then
Selection.Characters.Text = ""
Else
For i = 0 To UBound(a) - 1
If Left(c, 1) = a(i) Then
Selection.Characters.Text = a(i + 1)
Exit For
End If
Next i
End If
Cells(1, 1).Select
End Sub

回答No.1

mitarashi · ベストアンサー

ご呈示のコードとは離れますが、Arrayの何番目を表示しているか、AlternativeTextに保存しておくという案はいかがでしょうか。ご参考まで。
Sub 四角形1_Click()
Dim shp As Shape
Dim counter As Long
Dim a As Variant

a = Array("", "ABC", "BCD", "CDE", "DEF", "EFG", "FGH", "GHI")
Set shp = ActiveSheet.Shapes(Application.Caller)
If shp.AlternativeText = "" Then
counter = 0
Else
counter = Val(shp.AlternativeText)
If counter = UBound(a) Then
counter = 0
Else
counter = counter + 1
End If
End If
shp.AlternativeText = CStr(counter)
shp.TextFrame.Characters.Text = a(counter)
End Sub

お礼

ご回答ありがとうございました。Alternative Textに保存するのは時間効率からもすばらしい案ですね。お手数おかけしました。

回答No.3

imogasi

>図形の中に7つの文字(確認要、手続き中など)を・・
ここが良くわからない。「文字」と言うより、「７種類の語句」とか「７種類の作業名」とか表現すべきではないのか？各々の文字数は関係有るのか？
７文字といえば「確認要、手続き中」は８文字だし。
私の下記のコードのようなことなら、ことさら質問するほどのことではないと思うから迷う。
推測で、
Sub 四角形1_Click()
a = Array("確認要", "日付変化", "手続中", "待ち", "閉じる", "応答", "終了")
ActiveSheet.Shapes("Rectangle 1").Select
c = Selection.Characters.Text
c = Left(c, 1)
For i = 0 To UBound(a) - 1
If c = Left(a(UBound(a)), Len(c)) Then
Selection.Characters.Text = a(0)
Else
If c = Left(a(i), Len(c)) Then
Selection.Characters.Text = a(i + 1)
Exit For
End If
End If
Next i
Cells(1, "A").Select
End Sub
ーーー
Sub test01()
ActiveSheet.Shapes("Rectangle 1").Select
Selection.Characters.Text = "確認要"
End Sub
を実行後、四角を順次クリックして、サイクリックに変わることを確認したが。

お礼

説明不足で失礼致しました。ご推察のとおり７つの作業種類を意図しておりお手数おかけしました。ご回答ありがとうございました。

回答No.2

watabe007

こんにちは、こんな方法も
Sub 四角形1_Click3()
Dim shp As Shape
Dim a As Variant, myR As Variant
a = Array("", "確認要", "手続き中1", "手続き中2", "手続き中3", "手続き中4")
Set shp = ActiveSheet.Shapes(Application.Caller)
myR = Application.Match(shp.TextFrame.Characters.Text, a, 0)
If IsError(myR) Then myR = 0
shp.TextFrame.Characters.Text = a(myR Mod (UBound(a) + 1))
End Sub

お礼

ご回答ありがとうございました。うまく入りました。この数日の悩みがすっきりしました。