Excel VBA質問箱 IV

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

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


14514 / 76734 ←次へ | 前へ→

【67710】Re:AutoShapeについて
回答  りん E-MAIL  - 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 'とりあえず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

こんな感じです。

2 hits

【67709】AutoShapeについて Yoshim 11/1/2(日) 16:20 質問
【67710】Re:AutoShapeについて りん 11/1/2(日) 19:26 回答
【67711】Re:AutoShapeについて Yoshim 11/1/2(日) 22:44 質問

14514 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free