Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

14514 / 76734

←次へ　｜　前へ→


	【67710】Re:AutoShapeについて

りん

- 11/1/2(日) 19:26 -


	引用なし

	パスワード

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 'とりあえず２回
　　　　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

こんな感じです。

3 hits

▼

【67709】AutoShapeについて Yoshim 11/1/2(日) 16:20