| |
▼椿 さん：
おはようございます。
>例：A1セルに"刹那X5"を打てば、オートシェイプに入り（ここまではマクロ不要です）、オートシェイプ内に刹那X5と表記され、X5がキーワードとしてオートシェイプの色を変更するマクロを作りたいのですが、うまくいきませんのでよろしくお願いいたします。
うまくいかないコードを提示するようにしてくださいね！！
新規ブックにて
標準モジュールに
'===========================================================
Sub 準備()
Dim rng As Range
With ActiveSheet
Set rng = .Range("c5:e6")
With .TextBoxes.Add(rng.Left, rng.Top, rng.Width, rng.Height)
.Name = "T1"
.Formula = "=$a$1"
With .Font
.Size = 16
End With
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End With
End Sub
Sheet1をアクティブにして、上記の「準備」を実行してください。
テキストボックスですが、C5:E6辺りに作成されます。
次に Sheet1のシートモジュールに
'=============================================================
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim regx As Object
Dim matches As Object
Dim ttarget As Range
Dim 色替えリスト As Variant
Dim 色 As Variant
Dim idx As Variant
色替えリスト = Array("x5", "y11", "zz33", "D51")
色 = Array(vbRed, vbCyan, vbYellow, vbBlue)
Set ttarget = Application.Intersect(Target, Range("a1"))
If Not ttarget Is Nothing Then
TextBoxes("T1").Interior.ColorIndex = xlNone
Set regx = CreateObject("VBScript.RegExp")
regx.Pattern = "(" & Join(色替えリスト, "|") & ")$"
regx.IgnoreCase = True
regx.Global = True
Set matches = regx.Execute(ttarget.Value)
If matches.Count = 1 Then
idx = Application.Match(matches(0).Value, 色替えリスト, 0)
TextBoxes("T1").Interior.Color = 色(idx - 1)
End If
Set regx = Nothing
Set matches = Nothing
End If
Set ttarget = Nothing
End Sub
Sheet1のセルA1に 刹那x5 と指定するとテキストボックスが赤くなります。
色の変化のある文字列は、
末尾が x5 y11 zz33 D51 に対して
赤 シアン 黄 青 に設定してあります。
それ以外は、色なし
これで試してみてください。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
