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

最終更新日：2021-01-13

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

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

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

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

出題

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

VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。

他の人の回答および解説を見て、書いたVBAを見直してみましょう。

頂いた回答

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

解説

ファイル選択は、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）

・図形オートシェイプ（Shape）関連のオブジェクト群・図形オートシェイプ（Shape）の追加・図形オートシェイプ（Shape）の削除・図形オートシェイプ（Shape）の編集・図形オートシェイプ（Shape）の全選択・図形オートシェイプ（Shape）の扱い方を工夫する・オートシェイプ（Shape）を扱う実践例・図形オートシェイプ（Shape）に関連する記事

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

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

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

・Pictures.Insertメソッド・Shapes.AddPictureメソッド・Shapesに関連する記事

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

・写真をサムネイルに変換して取り込むVBA ・写真をサムネイルに変換して取り込むVBAの解説・Shapesに関連する記事

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

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

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

1.最終行の取得（End,Rows.Count）｜VBA入門
2.RangeとCellsの使い方｜VBA入門
3.繰り返し処理（For Next)｜VBA入門
4.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
5.変数宣言のDimとデータ型｜VBA入門
6.マクロとは？VBAとは？VBAでできること｜VBA入門
7.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
8.条件分岐（IF）｜VBA入門
9.並べ替え（Sort）｜VBA入門
10.Range以外の指定方法（Cells,Rows,Columns）｜VBA入門

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

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

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

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