Excel VBA質問箱 IV

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

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


2489 / 13645 ツリー ←次へ | 前へ→

【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 質問[未読]

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

引用なし
パスワード
   検索で探したのですが、希望するコードが無かったため・・・
よろしくお願いします。

事前に"rectangle"の作成をしておいて、そこに画像を再現することは出来るのですが、
RectangleのオートシェイプをA6,D6,H6→A10・・・と発生させたいのですが
その方法をアドバイスいただきたく、よろしくお願いします。
 

【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

こんな感じです。

【67711】Re:AutoShapeについて
質問  Yoshim  - 11/1/2(日) 22:44 -

引用なし
パスワード
   ▼りん さん:

早速、すばらしいコードをご提供いただきありがとうございます。
画像をオートシェルに入れるように考えていました。
いただいたコードを一部変更を加え次のようにさせていただきました。
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
  Dim i As Integer, m As Integer, Filename
  '
  s1 = "ADH" 'ループする列を示す文字
  Set ws = Application.ActiveSheet
  i = 6
  m = 1
  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, 50, 50)
        '四角形に何かする時はspに対して処理
'        sp.Fill.ForeColor.SchemeColor = 3 '色を塗る
        Filename = _
         ThisWorkbook.Path & "\data\" & Cells(i, 10).Value
         sp.Fill.UserPicture Filename
      End With
        i = i + 1
        m = m + 1
    Next
  Next
  '終了
  Set sp = Nothing: Set r1 = Nothing: Set ws = Nothing
End Sub
一応、思っていた感じに写真が入りました。しかし自分で変更を加えながら、意味が分かっていないのです・・・
Set sp = ws.Shapes.AddShape(msoShapeRectangle, _
           .Left, .Top, 50, 50)
のコードはセルの左上の角に当て、50角と理解して良いのでしょうか。
この時の単位は何なのでしょうか?
後一点お聞きしたいのですが、Rectangleの連番が、操作をすればどんどん数字が加算されていきますが、
例えば「四角形1」から「四角形6」(とりあえず)をつけようと変数mを利用しようとしましたが、どの位置につけてもエラーになっています、これは可能でしょうか? お時間が許せば、よろしくお願いします。

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