|
Yoshim さん、こんばんわ。
>RectangleのオートシェイプをA6,D6,H6→A10・・・と発生させたいのですが
>その方法をアドバイスいただきたく、よろしくお願いします。
新しく追加していく例です。
Sub test()
Dim s1 As String
Dim CC As Long, RR As Long, Rpos As Long
Dim r1 As Range, sp As Shape, ws As Worksheet
'
s1 = "ADH" 'ループする列を示す文字
Set ws = Application.ActiveSheet
For RR = 1 To 2 'とりあえず2回
Rpos = RR * 4 + 2 '6,10(,14・・・)
For CC = 1 To 3
Set r1 = ws.Cells(Rpos, Mid(s1, CC, 1)) '図形を作成するセル
With r1
'とりあえずセルと同じサイズ四角形を追加
Set sp = ws.Shapes.AddShape(msoShapeRectangle, _
.Left, .Top, .Width, .Height)
'四角形に何かする時はspに対して処理
sp.Fill.ForeColor.SchemeColor = 3 '色を塗る
End With
Next
Next
'終了
Set sp = Nothing: Set r1 = Nothing: Set ws = Nothing
End Sub
こんな感じです。
|
|