[EXCEL画像貼付]AddPictureのパラメータ設定(表示サイズ設定): 縁木求魚

« シートマクロ例:セルに値が入力されたら、別セルに値表示する。 | トップページ | [EXCELVBA]画像を見ながら、ファイル名を変更する その2。 »

2019年4月 2日 (火)

[EXCEL画像貼付]AddPictureのパラメータ設定(表示サイズ設定)

エクセルVBAで画像貼付けする場合、AddPictureメソッドを使っています。

 ※メソッドと関数の違い
  参考: https://wa3.i-3-i.info/diff97function.html
      https://teratail.com/questions/59819

 AddPictureメソッドのパラメータ
 参考URL https://docs.microsoft.com/ja-jp/office/vba/api/excel.shapes.addpicture#syntax

 構文 expression. AddPicture(Filename ,LinkToFile,SaveWithDocument,Left,Top,Width,Height)
    filename:=ファイル名
    Linktofile:=true 又は False
    SaveWithDocument:=true 又は False
    Left:=貼り付ける場所(左からの位置、ポイント数で)
    Top:=貼り付ける場所(上からの位置、ポイント数で)
    Width:=貼り付ける表示巾(元のサイズの場合、-1 とする。)
    Height:=貼り付ける表示の高さ(元のサイズの場合、-1 とする。)

 Left,Top,Width,Heightはそれぞれポイント数(100とか300とか)で指定してもよいが、シート上ではわかりずらいので、セル番地指定が分かり易いし、使いやすいと思います。

 

 例えば、セルをselectして、そこに貼り付けるなら、
 Left:=Selection.Left, Top:=Selection.Top,Width:=300, Height:=100
 とする。
 選択セルの左上・上端に、画像の左隅として貼り付けます。
 この場合、貼り付ける画像の横幅300ポイント、高さは100としています。
 WidthやHeightの値を変えることで、表示サイズを調整することができます。
 

■変数の定義
 Dim Tate As Single '貼り付けた画像の高さ
 Dim Yoko As Single '貼り付けた画像の幅
 Dim Top As Single '貼り付け上端位置
 Dim Left As Single '貼り付け左端位置
 Dim PicData As Object  ' 貼り付ける画像(オブジェクト)


■元のサイズで貼り付ける場合
 Left:=Activecell.Left, Top:=Activecell.Top,Width:=-1, Height:=-1 とすると、

全構文では、
Set PicData = ActiveSheet.Shapes.AddPicture(画像ファイル, True, True, ActiveCell.Left, ActiveCell.Top, -1, -1)
 とすると、Width,Heightがそれぞれ -1 となっているので、元ファイルのサイズで表示されます。


■セルの大きさで貼り付ける場合
 Tate = ActiveCell.Height
 Yoko = ActiveCell.Width
 ’又は
 'Tate = Selection.Height
 'Yoko = Selection.Width

Top = ActiveCell.Top
Left = ActiveCell.Left

Set PicData = ActiveSheet.Shapes.AddPicture(画像ファイル, True, True, Left, Top, Yoko, Tate)
とします。


■結合セルの大きさで貼り付ける場合
Tate = ActiveCell.MergeArea.Height
Yoko = ActiveCell.MergeArea.Width

Top = ActiveCell.Top
Left = ActiveCell.Left

Set PicData = ActiveSheet.Shapes.AddPicture(画像ファイル, True, True, Left, Top, Yoko, Tate)
とします。


■アクティブセルに画像ファイルの縦横比を同じにして貼り付ける場合

 Top = ActiveCell.Top
 Left = ActiveCell.Left
 Set PicData = ActiveSheet.Shapes.AddPicture(画像ファイル, True, True, Left, Top, -1, -1)

'一旦、元のサイズで貼り付けてから、サイズ変更します。

' 幅を基準に高さを調整する場合。
PicData.Height = PicData.Height * (Yoko / PicData.Width)
PicData.Width = Yoko

'高さを基準に、幅を調整する場合。
PicData.Width = PicData.Width * (Tate / PicData.Height)
PicData.Height = Tate


■アクティブセルに貼り付けて、回転させる場合
 Set PicData = ActiveSheet.Shapes.AddPicture(画像ファイル, True, True, ActiveCell.Left, ActiveCell.Top, Yoko, Tate)

 With PicData
  .IncrementRotation 30  ' ←30度回転させる。
 End With
  
■表示させたい画像を縮小してから、貼り付ける場合
  https://engi.cocolog-nifty.com/sirenai/2019/03/post-466b.html
  https://engi.cocolog-nifty.com/sirenai/2019/03/post-28a9.html

■貼り付けた画像が大きいので、縮小させたい場合
  ※シート上の画像を図として貼り付けなおす処理となります。
  http://satoshi4500blog.blog.fc2.com/blog-entry-126.html を参照
  又は、
  
Sub 画像一括貼付け直し()
' 図に設定したリンクは消えます。
' Link:=Trueとすると、エラーになります。

Dim Pic As Object
Dim Pictop As Double, Picleft As Double

For Each Pic In ActiveSheet.Pictures
If TypeName(Pic) <> "OLEObject" Then
Pic.Select
Pictop = Pic.Top
Picleft = Pic.Left
Selection.Cut '画像をコピー&切り取りします。
' 形式を選択して貼り付ける.
ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False
Selection.Left = Picleft
Selection.Top = Pictop
End If
Next

MsgBox "図形を貼り付けなおしました。"
End Sub

となります。

 

 

 

|

« シートマクロ例:セルに値が入力されたら、別セルに値表示する。 | トップページ | [EXCELVBA]画像を見ながら、ファイル名を変更する その2。 »

ExcelVBA画像貼付」カテゴリの記事

コメント

コメントを書く



(ウェブ上には掲載しません)




« シートマクロ例:セルに値が入力されたら、別セルに値表示する。 | トップページ | [EXCELVBA]画像を見ながら、ファイル名を変更する その2。 »