VBA練習問題
VBA100本ノック 64本目:リンクされた図(カメラ機能)

VBAを100本の練習問題で鍛えます
最終更新日:2021-02-22

VBA100本ノック 64本目:リンクされた図(カメラ機能)


「元表1」「元表2」の2シートの表範囲を「リンクされた図」として「まとめ」シートに貼り付ける問題です。


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

VBAテスト用のサンプルデータは、VBA100本ノックの目次ページ からもダウンロードできます。
マクロVBAを初心者向けの基本から上級者向けの高度な内容までサンプルコードを掲載し解説しています。エクセル関数・機能・基本操作の入門解説からマクロVBAまでエクセル全般を網羅しています。


出題

出題ツイートへのリンク

#VBA100本ノック 64本目
「元表1」「元表2」の2シートのA1からの表範囲を「リンクされた図」として「まとめ」シートに貼り付けてください。
貼り付け位置
・「元表1」はA1:J20の範囲へ
・「元表2」はA21:J40の範囲へ
※範囲内の縦横位置は任意
※再実行を考慮し、前回貼り付け分は削除してください。

マクロ VBA 100本ノック


手動での操作
セル範囲をコピーした後に、貼り付けるときに「貼り付けオプション」の右下の「リンクされた図」で貼りつけます。
カメラ機能とも呼ばれています。

マクロ VBA 100本ノック


サンプルファイルです。
https://excel-ubara.com/vba100sample/VBA100_64.xlsm
https://excel-ubara.com/vba100sample/VBA100_64.zip


VBA作成タイム

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


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


頂いた回答

解説

いわゆるカメラ機能になります。
印刷レポート作成の時には重宝する機能です。
WorksheetのPicturesは、オブジェクトブラウザでも隠しメンバーとなっていて調べづらいですね。
こういう処理は「マクロの記録」があるのがとても助かります。

Sub VBA100_64_01()
  Dim wsまとめ As Worksheet: Set wsまとめ = Worksheets("まとめ")
  Dim ws元表1 As Worksheet: Set ws元表1 = Worksheets("元表1")
  Dim ws元表2 As Worksheet: Set ws元表2 = Worksheets("元表2")
  
  Call delLinkPictutr(wsまとめ)
  Call setLinkPicture(wsまとめ.Range("A1:J20"), ws元表1)
  Call setLinkPicture(wsまとめ.Range("A21:J40"), ws元表2)
End Sub

Sub delLinkPictutr(ByVal ws As Worksheet)
  Dim sp As Picture
  For Each sp In ws.Pictures
    'リンクされた画像のみ削除
    On Error Resume Next
    If sp.Formula <> "" Then
      If Err.Number = 0 Then sp.Delete
    End If
  Next
End Sub

Sub setLinkPicture(aRng As Range, ByVal ws元表 As Worksheet)
  Dim ws As Worksheet: Set ws = aRng.Worksheet
  ws元表.Range("A1").CurrentRegion.Copy
  With ws.Pictures.Paste(link:=True)
    '縦横比を固定(されているけど)してサイズ調整
    .ShapeRange.LockAspectRatio = msoTrue
    If .Width > aRng.Width - 2 Then .Width = aRng.Width - 2
    If .Height > aRng.Height - 2 Then .Height = aRng.Height - 2
    '上に揃えて、左右は真ん中
    .Top = aRng.Top
    .Left = aRng.Left + ((aRng.Width - .Width) / 2)
  End With
  Application.CutCopyMode = False
End Sub


前回分の図の削除は、ShapesやPicturesを全て削除しても構わないと思いますが、
上記ではリンクされているものだけ削除するようにしました。
サイズ・位置調整については「29本目:画像の挿入」でやったものがそのまま使えます。
・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
補足はありません。


補足

補足はありません。


サイト内関連ページ

第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本ノック」の記事

61本目:「ふりがな」の取得と設定
62本目:独自のZLOOKUP関数を作成
63本目:複数シートの連結
64本目:リンクされた図(カメラ機能)
65本目:固定長テキスト出力
66本目:全サブフォルダからファイルを探す
67本目:ComboBoxとListBox
68本目:全テキストボックスの転記
69本目:ダブルクリックでセル結合を解除
70本目:ステータスバーに1秒ごとに時刻が表示
71本目:パワーポイントへグラフを貼り付け


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

構成比を合計しても100%にならないと言われた…|ツイッター出題回答 (2022-09-01)
一覧から複数条件(部分一致、範囲)に合致するデータを抽出する|ツイッター出題回答 (2022-08-30)
縦横スピルしないXLOOKUP代替(MATCH+INDEX,FILTER,CHOOSEROWS)|エクセル入門(2022-08-27)
IF関数の論理式で比較演算子を省略したCOUNT系関数を書くのは|ツイッター出題回答 (2022-08-23)
LAMBDA以降の新関数の使用例|エクセル入門(2022-08-22)
数珠順列(配置に条件付き)を全て出力する|ツイッター出題回答 (2022-08-20)
日付時刻のマイナス表示に対応する方法|ツイッター出題回答 (2022-08-17)
LAMBDA以降の新関数について|エクセル入門(2022-08-16)
条件付きの最大値と中央値("A"が2文字の条件)|ツイッター出題回答 (2022-08-14)
VBAマクロと操作対象データの分離について|ツイッター出題回答 (2022-08-11)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.繰り返し処理(For Next)|VBA入門
5.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
6.Excelショートカットキー一覧|Excelリファレンス
7.並べ替え(Sort)|VBA入門
8.マクロって何?VBAって何?|VBA入門
9.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
10.エクセルVBAでのシート指定方法|VBA技術解説




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


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



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