VBA100本ノック 29本目：画像の挿入

最終更新日：2021-01-13

VBA100本ノック 29本目：画像の挿入

指定の画像をアクティブセル内に収まるように貼り付ける問題です。

ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。

VBAテスト用のサンプルデータはご自身でご用意ください。

出題

#VBA100本ノック 29本目
ファイル選択ダイアログで画像ファイルを指定し、その画像をアクティブセルにリンクしない図として貼り付けてください。
貼り付けた画像は、縦横比を維持したままセル内に収めてください。
セル内の位置はなるべく真ん中に。
※選択できる拡張子は適当に。

頂いた回答

出題ツイートの引用ツイートでの回答

解説

ファイル選択は、ApplicationのGetOpenFilenameまたはFileDialogです。
今回はGetOpenFilenameを使いました。
画像の挿入は、マクロの記録ではPictures.Insertになりますが、これは元画像にリンクしてしまいます。
切り取り直せば良いですが、VBAには便利なShapes.AddPictureがあります。


  
    
      Sub VBA100_29_01()

　　Dim rng As Range

　　Set rng = ActiveCell

　　

　　Dim FileName As Variant

　　FileName = Application.GetOpenFilename(FileFilter:="画像ファイル,*.bmp;*.jpg;*.gif")

　　If FileName = False Then

　　　　Exit Sub

　　End If

      　　

　　With rng.Worksheet.Shapes.AddPicture(FileName:=FileName, _

　　　　　　　　　　　　　　　　　　　　 LinkToFile:=False, _

　　　　　　　　　　　　　　　　　　　　 SaveWithDocument:=True, _

　　　　　　　　　　　　　　　　　　　　 Left:=rng.Left, _

　　　　　　　　　　　　　　　　　　　　 Top:=rng.Top, _

　　　　　　　　　　　　　　　　　　　　 Width:=0, _

　　　　　　　　　　　　　　　　　　　　 Height:=0)

　　　　.LockAspectRatio = msoTrue '縦横比固定

　　　　.Placement = xlMoveAndSize '移動&サイズ変更

      　　　　.ScaleHeight 1, msoTrue '縦を元のサイズに

      　　　　.ScaleWidth 1, msoTrue '横を元のサイズに

      　　　　

　　　　If .Width > rng.Width - 2 Then .Width = rng.Width - 2

      　　　　If .Height > rng.Height - 2 Then .Height = rng.Height - 2

      　　　　

　　　　.Top = .Top + ((rng.Height - .Height) / 2)

　　　　.Left = .Left + ((rng.Width - .Width) / 2)

　　End With

End Sub

今回は特に補足することも無いのですが、上記VBAを書くときにサイズ指定のあたりで気を付けた事等を記事補足に記載しました。

補足

引数の、
LinkToFile:=False
SaveWithDocument:=True
これでリンクしない図になります。

縦横比を維持するには、
LockAspectRatio = msoTrue
これを指定してしまうのが簡単だと思います。
後は、縦横のサイズをセルのサイズ以下にするだけです。

マイナス2しているのは、見た目として枠線に重ならないようにするためです。

上がマイナス2している場合で、下がマイナスしていない場合です。
このあたりは好みの部分なので、今回はこのようにしてみたという事です。

サイト内関連ページ

第97回．図形オートシェイプ（Shape）

マクロVBAで、オートシェイプ（図形）を扱う場合の解説です。オートシェイプ（図形）はShapeオブジェクトであり、ShapeオブジェクトのコレクションがShapesコレクションになります。Shapeオブジェクトは、多くのオブジェクトをメンバーに持った複雑なオブジェクトとなっています。

図をセル内に強制的に収める（Shape）

図（画像等）をエクセルに貼り付けた後、セルの移動と一緒に動かない場合があります。もちろん、図の書式のプロパティでは、「セルに合わせて移動」にしてある場合の話です。図がセルを大きくはみ出しているいる場合（隣のセルよりさらにはみだしている場合）は、セルのコピー、移動にくっていてきません。

写真の取込方法について（Pictures.Insert,Shapes.AddPicture）

写真を取り込んで、アルバムのようにしたり、各種の資料を作ったりと、写真をエクセルに取り込む機会は多いようです。しかし、最近は写真のサイズも大きくなり、手動で取り込んだままではスクロールもままならない状態となってしまいます。そこで写真ファイルを指定し、A列に上から順番に貼り付け、さらにセル内に収まるように縮小するVBAになります。

写真をサムネイルに変換して取り込む（Shapes.AddPicture）

写真を取り込んだ場合、リンクすると元のファイルが無いと画像が見られず、リンクせずに取り込むとファイルサイズが巨大化してしまいます。そこで、サムネイルを作成しそれをセルに貼り付け、元のファイルへのハイパーリンクを付けておくようにします。写真の取込方法の基本については以下をご覧ください。

同じテーマ「VBA100本ノック」の記事

26本目：ファイル一覧作成
 27本目：ハイパーリンクのURL
28本目：シートをブックに分割
29本目：画像の挿入
30本目：名札作成（段組み）
31本目：入力規則
 32本目：Excel終了とテキストファイル出力
 33本目：マクロ記録の改修
 34本目：配列の左右回転
 35本目：条件付き書式
 36本目：列の並べ替え

アクセスランキング・・・ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.RangeとCellsの使い方｜VBA入門
3.変数宣言のDimとデータ型｜VBA入門
4.マクロって何？VBAって何？｜VBA入門
5.Range以外の指定方法（Cells,Rows,Columns）｜VBA入門
6.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
7.繰り返し処理（For Next)｜VBA入門
8.セルに文字を入れるとは（Range,Value）｜VBA入門
9.マクロはどこに書くの（VBEの起動）｜VBA入門
10.とにかく書いてみよう（Sub,End Sub）｜VBA入門

ホーム
マクロVBA入門編
VBA100本ノック
29本目：画像の挿入

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。

VBA練習問題
VBA100本ノック 29本目：画像の挿入