アプリ版:「スタンプのみでお礼する」機能のリリースについて

御世話になります。
他の人のエクセル マクロで写真帳を見よう見まねで作成したのですが、現在複数シートに写真を1枚1枚張り付けてますが、最近になり写真を貼り付ける作業が増えており、作業効率を上げたいと考えました。つきましてはボタン一発で複数写真を各シートの指定された場所に写真を貼り付けることが出来たら・・・。と思っております。画像は実際に使用している写真帳の画面コピーです。1シートに3枚写真を貼り付ける仕様です。シートは基本15シートあります。必要によりシートの増減をしてます。
ちなみに今現在使用しているマクロは下記になります。

Sub 写真貼付1()
'
' 写真貼付2 Macro
'
' 写真貼り付け Macro
'
Dim StrFilter As String
Dim 画像ファイル As Variant
Dim Tate As Single
Dim Yoko As Single
Dim Top As Single
Dim Left As Single
Dim PicData As Object

Cells(13, 2).Select

Tate = ActiveCell.MergeArea.Height

Yoko = ActiveCell.MergeArea.Width

画像ファイル = ""
StrFilter = "画像ファイル(*.jpg;*.jpeg;*.gif;*.bmp;*.png),*.jpg;*.jpeg;*.gif;*.bmp;*.png"

画像ファイル = Application.GetOpenFilename(FileFilter:=StrFilter, _
FilterIndex:=1, _
Title:="画像ファイルを選択してください。", _
MultiSelect:=False)

If 画像ファイル = "False" Then Exit Sub

Top = ActiveCell.Top
Left = ActiveCell.Left


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




ActiveCell.Offset(, 1).Select
'
End Sub
上記のマクロを3個用意してそれぞれ各シートの1段目、2段目、3段目に写真を貼り付ける様にしてます。
当方マクロは初めたばかりです。何か良い知恵を御貸し頂けないでしょうか?
宜しくお願い致します。

「エクセル マクロ写真帳に一括で写真を張り」の質問画像

A 回答 (2件)

こんばんは


やり方は色々ありますが、すでに回答にあるような手順が最も簡単かと
済めされているコードを使用して少し具体的にすると

GetOpenFilenameを使われているのでMultiSelect:=Falseを
MultiSelect:=Trueとして複数選択できるようにします

この時、変数 画像ファイル は Dim 画像ファイル As Variant で宣言しているので、ファイルを選択した時は、配列になり
キャンセルを押した時は  False (Boolean)が返ります。
なのでキャンセル時の対応は If 画像ファイル = "False" Then Exit Sub ではなく 
If Not IsArray(画像ファイル) Then Exit Sub や
If 画像ファイル = False Then Exit Sub で回避します。
どちらでも多分大丈夫

配列内のデータ数(情報)でループして 各結合セルにAddPictureすれば良いと思いますので、、

例として 1つ目結合セルの左上セルがB3セルで12行飛びの場合

If 画像ファイル = False Then Exit Sub
n = 3 'スタート行
If UBound(画像ファイル) <= 3 Then '3つ迄が対象
For i = 1 To UBound(画像ファイル)
With ActiveSheet.Cells(n, "B").MergeArea
Tate = .Height
Yoko = .Width
Top = .Top
Left = .Left
ActiveSheet.Shapes.AddPicture 画像ファイル(i), True, True, Left, Top, Yoko, Tate
End With
n = n + 12 '次の結合セル行に
Next
End If

セルの移動と配列について少しの学習が必要
変数nは整数型で 行 なのでLong型が安心  iは整数型ならOK
画像ファイルの順番はGetOpenFilenameでフォルダー内の表示順になります
フォルダでの並び替えで変更は可能ですが、選択順ではありません。
    • good
    • 0

こんにちは



>ボタン一発で複数写真を各シートの指定された場所に写真を貼り付けることが出来たら
検索してみればそのような事例も数多く見つかることと思います。
(質問者様のご要望にピッタリとは限りませんが、要領は分かると思います)

まとめて行う場合は、
・画像をフォルダなどにまとめて入れておく
 (そのフォルダ内の画像を順に貼り付ける)
・貼り付け先のセル位置が決まっている
 (ご提示の画像ではセル位置が不明です)
・画像の縦横比と、セル範囲の縦横比が違う場合の合わせ方
などを事前に決めておいて、それに従って順に処理するようなマクロにすれば良いでしょう。

基本的には、1枚分を貼り付ける処理をまず作成し、それを一般化して、あとは枚数分ループするようなイメージで作成可能と想像します。
以下、似た様な例をご参考までに。
(検索すれば、もっといろいろ見つかるはずです)
https://www.higashisalary.com/entry/vba-pictures …
https://tonari-it.com/excel-vba-shapes-addpictur …
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A