このマクロはこんな人向けです！
- Windowsの「フルページ印刷」ではない！
- 1ページに1枚の画像をファイル名をキープして印刷したい
- 「フォト」印刷のイメージでファイル名付きで連続印刷をしたい
- 画像のファイル名を見せて印刷したい
- フォルダにある一部のファイルを連続印刷したい
- 印刷するファイルは、リストを作らず、選択だけで済ませたい
注意点
「フルページ印刷」よりも小さく印刷されます。
印刷のイメージ
エクセルのシートに指定した画像を1つずつ開いて印刷します。
ファイル名はヘッダーに表示させます。
ソースコード
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 | Sub Sample1() Dim ws(1) As Worksheet Dim myShp As Object Dim prtRng As Range '//ファイルを開くダイアログを開く selectFileArray = Application.GetOpenFilename( _ FileFilter:="画像ファイル,*.jpg*;*.png;*.gif", _ FilterIndex:=1, _ Title:="複数ファイル選べるよ♪", _ MultiSelect:=True) '//選択したファイルに対する処理 If IsArray(selectFileArray) Then '//全てのファイルで繰り返し処理を行う For Each oneFileName In selectFileArray '//選択されたファイルを開く Set ws(1) = Sheets("Sheet2") '画像読込&印刷シート With ws(1) '//右上ヘッダーにファイル名を入れる .PageSetup.RightHeader = _ Right(oneFile, InStr(StrReverse(oneFile), "\") - 1) Set prtRng = .Range("A1:P45") '画像の読込範囲を指定 Set myShp = .Pictures.Insert(oneFile) '画像読込 With .Shapes.Range(myShp.Name) .ZOrder msoSendToBack '最背面に配置 .LockAspectRatio = msoTrue '縦横比を固定 .Width = prtRng.Width '横幅 .Left = prtRng.Left '水平位置 .Top = prtRng.Top '垂直位置 ws(1).PrintOut From:=1, To:=1 '1ページ印刷実行 .Delete '画像を削除 End With End With Next Else MsgBox ("ファイルを選択しないで終了") End If End Sub |
解説および注意点
- 印刷する際はプリンタの設定で用紙サイズを指定しておくこと
- 今のコードの印刷はA4横を想定しています
- ページレイアウトで「余白」を小さくしておくと、より大きく画像を表示できます
A4縦に印刷するには
ページレイアウトで、印刷の向きを「縦」に設定します。
画像読み込み範囲を変更します。
Set prtRng = .Range(“A1:P45“)
黄色着色部分を、1ページ範囲の右下のセルにします。
参考にしたサイト
このマクロを作るのに参考にしたサイトは下記の2つです。
コメントを残す