| |
ichinose 様
申し訳ございませんでした。
ありがとうございました。
▼ichinose さん：
>▼椿 さん：
>おはようございます。
>
>>例：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 に対して
> 赤 シアン 黄 青 に設定してあります。
>
>それ以外は、色なし
>
>
>これで試してみてください。
|
|
椿
- 10/3/17(水) 16:44 -
