Excel VBA質問箱 IV

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

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


35053 / 76732 ←次へ | 前へ→

【46882】Re:画像の貼り付け
回答  Kein  - 07/2/19(月) 18:12 -

引用なし
パスワード
   UserFormに拘るなら、他の人のレスを待って下さい。
先に書いたダイアログシート方式なら、アクティブシートに4つの画像が
挿入されているとして・・

Sub Ap_Obj_Dialog()
  Dim Lp1 As Single, Tp1 As Single
  Dim Lp2 As Single, Tp2 As Single
  Dim Wp As Single, Hp As Single
  Dim i As Integer
 
  With ActiveSheet
   If .Pictures.Count < 4 Then Exit Sub
  End With
  With DialogSheets(1)
   If .DrawingObjects.Count > 0 Then
     .DrawingObjects.Delete
   End If
   With .DialogFrame
     Lp1 = .Left + 5: Tp1 = .Top + 15
     Lp2 = .Left + (.Width / 2 + 5)
     Tp2 = .Top + (.Height - 25) / 2 + 20
     Wp = .Width / 2 - 20: Hp = (.Height - 25) / 2
   End With
   For i = 1 To 4
     ActiveSheet.Pictures(i).Copy
     .Paste
     Application.CutCopyMode = False
   Next i
   With .Pictures
     With .Item(1)
       .Left = Lp1: .Top = Tp1
       .Width = Wp: .Height = Hp
     End With
     With .Item(2)
       .Left = Lp2: .Top = Tp1
       .Width = Wp: .Height = Hp
     End With
     With .Item(3)
       .Left = Lp1: .Top = Tp2
       .Width = Wp: .Height = Hp
     End With
     With .Item(4)
       .Left = Lp2: .Top = Tp2
       .Width = Wp: .Height = Hp
     End With
   End With
   .Show
  End With
End Sub

というコードで出来ます。
こちらでテストした環境で、うまく配置できてました。
5 hits

【46863】画像の貼り付け ニッキ 07/2/19(月) 12:04 質問
【46866】Re:画像の貼り付け Kein 07/2/19(月) 13:05 発言
【46869】Re:画像の貼り付け ニッキ 07/2/19(月) 13:33 発言
【46871】Re:画像の貼り付け りん 07/2/19(月) 14:11 発言
【46916】Re:画像の貼り付け ニッキ 07/2/21(水) 16:16 お礼
【46922】Re:画像の貼り付け Ned 07/2/21(水) 18:21 発言
【46926】Re:画像の貼り付け ニッキ 07/2/22(木) 9:31 お礼
【46923】Re:画像の貼り付け りん 07/2/21(水) 19:18 回答
【46925】Re:画像の貼り付け ニッキ 07/2/22(木) 9:29 質問
【46928】Re:画像の貼り付け ニッキ 07/2/22(木) 11:11 質問
【46932】Re:画像の貼り付け りん 07/2/22(木) 13:23 回答
【46934】Re:画像の貼り付け ニッキ 07/2/22(木) 13:48 お礼
【46938】Re:画像の貼り付け りん 07/2/22(木) 16:14 発言
【46872】Re:画像の貼り付け Kein 07/2/19(月) 14:30 回答
【46880】Re:画像の貼り付け ニッキ 07/2/19(月) 16:21 質問
【46882】Re:画像の貼り付け Kein 07/2/19(月) 18:12 回答
【46908】Re:画像の貼り付け ニッキ 07/2/21(水) 15:16 質問
【46910】Re:画像の貼り付け Kein 07/2/21(水) 15:57 発言
【46914】Re:画像の貼り付け ニッキ 07/2/21(水) 16:09 お礼

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