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

VBAを100本の練習問題で鍛えます
最終更新日:2020-11-21

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


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


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


出題

出題ツイートへのリンク

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

マクロ VBA 100本ノック


頂いた回答

解説

ファイル選択は、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しているのは、見た目として枠線に重ならないようにするためです。

マクロ VBA 100本ノック
マクロ VBA 100本ノック

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


サイト内関連ページ

第97回.図形オートシェイプ(Shape)
マクロVBAで、オートシェイプ(図形)を扱う場合の解説です。オートシェイプ(図形)はShapeオブジェクトであり、ShapeオブジェクトのコレクションがShapesコレクションになります。Shapeオブジェクトは、多くのオブジェクトをメンバーに持った複雑なオブジェクトとなっています。
図をセル内に強制的に収める(Shape)
図(画像等)をエクセルに貼り付けた後、セルの移動と一緒に動かない場合があります。もちろん、図の書式のプロパティでは、「セルに合わせて移動」にしてある場合の話です。図がセルを大きくはみ出しているいる場合(隣のセルよりさらにはみだしている場合)は、セルのコピー、移動にくっていてきません。
写真の取込方法について(Pictures.Insert,Shapes.AddPicture)
写真を取り込んで、アルバムのようにしたり、各種の資料を作ったりと、写真をエクセルに取り込む機会は多いようです。しかし、最近は写真のサイズも大きくなり、手動で取り込んだままではスクロールもままならない状態となってしまいます。そこで写真ファイルを指定し、A列に上から順番に貼り付け、さらにセル内に収まるように縮小するVBAになります。
写真をサムネイルに変換して取り込む(Shapes.AddPicture)
写真を取り込んだ場合、リンクすると元のファイルが無いと画像が見られず、リンクせずに取り込むとファイルサイズが巨大化してしまいます。そこで、サムネイルを作成しそれをセルに貼り付け、元のファイルへのハイパーリンクを付けておくようにします。写真の取込方法の基本については以下をご覧ください。




同じテーマ「Python入門」の記事

VBA100本ノック 23本目:シート構成の一致確認
VBA100本ノック 24本目:全角英数のみ半角
VBA100本ノック 25本目:マトリック表をDB形式に変換
VBA100本ノック 26本目:ファイル一覧作成
VBA100本ノック 27本目:ハイパーリンクのURL
VBA100本ノック 28本目:シートをブックに分割
VBA100本ノック 29本目:画像の挿入
VBA100本ノック 30本目:名札作成(段組み)
VBA100本ノック 31本目:入力規則
VBA100本ノック 32本目:Excel終了とテキストファイル出力
VBA100本ノック 33本目:マクロ記録の改修


新着記事NEW ・・・新着記事一覧を見る

VBA100本ノック 34本目:配列の左右回転|VBA練習問題(11月28日)
VBA100本ノック 33本目:マクロ記録の改修|VBA練習問題(11月26日)
VBA100本ノック 32本目:Excel終了とテキストファイル出力|VBA練習問題(11月25日)
VBA100本ノック 31本目:入力規則|VBA練習問題(11月24日)
将棋とプログラミングについて~そこには型がある~|エクセル雑感(11月22日)
VBA100本ノック 30本目:名札作成(段組み)|VBA練習問題(11月22日)
VBA100本ノック 29本目:画像の挿入|VBA練習問題(11月21日)
VBA100本ノック 28本目:シートをブックに分割|VBA練習問題(11月19日)
VBA100本ノック 27本目:ハイパーリンクのURL|VBA練習問題(11月18日)
VBA100本ノック 26本目:ファイル一覧作成|VBA練習問題(11月17日)


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

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




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


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



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