写真の貼り付け

質問

こんにちは。少々ややこしいですがご教授ください。
大量の写真を同じように加工したいのですが、良い方法は無いものでしょうか？
写真の右下部分に一定の大きさで白抜きをし、そこに黒で文字（写真名称）を入れてプリントアウトします。
今考えているのが、写真をスキャニングしてファイル名を写真名称にします。エクセルでマクロ（？）を組んで、写真データの入っているフォルダを指定すると自動で読込みをし、それをＡ４用紙に印刷してカットすれば完成という方法です。読み込んだ際、写真の周りには自動でトンボのようなものが出（罫線で代用できるかな？）、同じく白抜き（オートシェイプに白塗り？）、文字もファイル名を取り込んで改めて打ち直す必要もない！という方法です。写真はＬ版の大きさでカットします。
いかがでしょうか？お聞きしたいのは(1)この方法の現実性。(2)さらに良い方法はないか。(3)これが現実的ならば具体的な操作（設定）方法。(4)エクセルで写真の印刷なので画質にどの程度問題があるか。(5)その他何でもアドバイス。です。
みなさんよろしくお願いいたします。

回答No.2

misatoanna · ベストアンサー

フォルダ内の写真１枚１枚を自動的にＡ４枚に印刷するソフトでしたら、Ｖｅｃｔｏｒあたりでも
幾つか見つかると思いますが、トンボをつけるソフトとなるとどうなのでしょうか。
写真画像ファイルをそのまま取り込むのでしたら、Ｅｘｃｅｌでも画質的には問題ないと思うので
すが。（多少落ちるのかも知れませんが、私個人は特に不満を感じたことはありません）

マクロは得意分野ではありませんが、夏休みの遊びで次のようなものを作ってみました。
・トンボつきです。
・画像は１枚印刷するたびにシート上から削除して新しいファイルを読み込みますので、ブックの
　 サイズは小さいままです。

1.スキャンした写真データファイルを、すべて任意のフォルダに保存します。
　 印刷する写真ファイル以外は保存しないでください。
2.新規でExcelを開いて Sheet1 以外のシートを削除し、次のように設定します。
　　・ページ設定で、Ａ４横、余白すべて０.5。
　　・シート全体を選択し、セル高とセル幅をすべて 18 ピクセル。
　　・テキストボックスを作成してとりあえず ABCDE と入力し、フォント種と文字
　　　 サイズ、色を指定してから、次のように設定。
　　　　・塗りつぶし白、枠線なし、自動サイズ調整。
　　　　・位置はどこでも構いません。印刷時の位置はマクロ内で設定されます。
3.改ページ線を表示してから、次のように設定します。
　　・B2からページ最終行ひとつ前の行のＢ列セルまでを結合。
　　・セル A1 に [書式]-[セル] 罫線タブから、右辺と下辺に一番細い罫線を設定。
　　　 ページ最終行のＡ列セルの右辺と上辺にも同様に罫線を設定。
4.[Alt]を押しながら[F11]で Ｖｉｓｕａｌ Ｂａｓｉｃ Ｅｄｉｔｏｒ を起動して、
　[挿入]-[標準モジュール] で開く画面に以下をコピペして実行します。
　'
　Sub PasteGazo()
　　　Dim FPath, FName, HGT, PPoint, BR
　　　Application.ScreenUpdating = False
　　　FPath = "C:\MyFiles\Pic\Photo"　　　　'←　※１
　　　FName = Dir$(FPath & "\" & "*.*")
　　　Do While FName <> ""
　　　　Range("B2").Select
　　　　HGT = Selection.Height
　　　　ActiveSheet.Pictures.Insert(FPath & "\" & FName).Select
　　　　　Selection.ShapeRange.LockAspectRatio = msoTrue
　　　　　Selection.ShapeRange.ZOrder msoSendToBack
　　　　　Selection.ShapeRange.Height = HGT
　　　　　Selection.Placement = xlFreeFloating
　　　　' ↓Textbox (Write Filename, Set Position)
　　　　ActiveSheet.Shapes(2).Select
　　　　　PPoint = InStr(FName, ".")
　　　　　Selection.Characters.Text = Left(FName, PPoint - 1)
　　　　　Selection.ShapeRange.Left = _
　　　　　　　ActiveSheet.Shapes(1).Left + ActiveSheet.Shapes(1).Width _
　　　　　　　　- (Selection.Width + 25)　　　　'←　※２
　　　　　Selection.ShapeRange.Top = _
　　　　　　　ActiveSheet.Shapes(1).Top + ActiveSheet.Shapes(1).Height _
　　　　　　　　- (Selection.Height + 20)　　　　'←　※３
　　　　' ↓Tombo
　　　　BR = ActiveSheet.Shapes(1).BottomRightCell.Column
　　　　Columns(BR - 1).ColumnWidth _
　　　　　　= ((ActiveSheet.Shapes(1).Width _
　　　　　　　- Range(Columns(2), Columns(BR - 2)).Width) * 4 / 3) / 8 - 0.62
　　　　With Cells(1, BR)
　　　　　.Borders(xlEdgeLeft).Weight = xlHairline
　　　　　.Borders(xlEdgeBottom).Weight = xlHairline
　　　　End With
　　　　With Cells(45, BR)　　　'←　※４
　　　　　　.Borders(xlEdgeLeft).Weight = xlHairline
　　　　　　.Borders(xlEdgeTop).Weight = xlHairline
　　　　End With
　　　　' ↓Print
　　　　ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True　'←　※５
　　　　' ↓Clear
　　　　Range(Columns(BR - 2), Columns(BR)).Delete
　　　　ActiveSheet.Shapes(1).Delete
　　　　FName = Dir$
　　　Loop
　　　Application.ScreenUpdating = False
　End Sub
　'
※１：実際の写真を保存したフォルダのフルパスに書き換えてください。
※２：最後の 25 はテキストボックス右端から写真右端までの距離(ポイント)です。
　　　 もっと離したい場合は数値を大きくしてください。（※３も同様です）
※３：最後の 20 はテキストボックス下端から写真下端までの距離(ポイント)です。
※４：45 の部分は、実際のページ最終行番号に書き換えてください。
※５：とりあえず印刷プレビューで確認するようにしています。確認が不要な場合は、
　　　 " , Preview:=True "　を削除してください。

回答No.1

komet163

こんにちは。

(1) について
マクロで実現できます。
しかし、写真の量が不明なのでなんとも言えませんが、
きっとスキャニングの手間が、と～っても たいへんでしょう(^_^;
デジカメで撮ってあれば手間は半分以下でしたね。

(2) について
スキャナをお持ちなら、そこそこの画像ソフトが付いていませんでしたか。
一覧印刷機能とか、カタログ印刷とか名称は様々ですが、
お望みの印刷物を出してくれるのではないでしょうか。

(3) について
http://oshiete1.goo.ne.jp/kotaeru.php3?q=1445196
に稚拙ながら、選択範囲に画素数を間引いて写真を貼り付けるマクロを
あげてあります。参考にしてください。

(4) について
写真の枚数にもよりますが、高画質を望むと
エクセルがデカクなります。(数メガ～数十メガ単位)
(3)のマクロは画質を調整できるようにしてあります。

(5) にいて
(2)をご検討なさってはどうでしょう。