プロが教える店舗&オフィスのセキュリティ対策術

工事の仕事をしています。
報告書をエクセルで書いて出すのですが、
現場の写真を大量に撮影して貼り付けなければなりません。

「挿入」→「ファイルから」で一枚一枚貼り付けているのですが手間でなりません。

デジカメで撮影した写真なのでファイル名は連番です。
一括でワークシートにズラッと並べて挿入することはできないのでしょうか?

週末1-200枚の写真を貼る為に残業するのは堪えます。
良い知恵をお貸し下さい。

gooドクター

A 回答 (5件)

工事写真票の作成ですか?報告書の提出時期ですものね。

(^^;)

工事写真ということで、次の点が重要になるかと思います。

1. 貼付けられる順番
  工事の様子を時間を追って撮影している場合、順番が重要です。
2. リサイズの問題
  工事写真は正確性が求められます。リサイズする場合、縦横比を固定すべきです。

1と2をクリアしつつ、貼付けを楽にするには、EXCELではマクロしか解決方法がありません。個人的にはVIXをお勧めしますが、一応EXCELでのマクロをアップします。貼付け後のサイズはセルの高さにあわせています。必要があれば、コードをカスタマイズして下さい。

ただ、他の方からもご指摘があるとおり、EXCELに200枚の画像は無茶ですね。複数のブックに切り分けましょう。

なお、マクロ[InsertPictures]は#2.papayukaさんのコードをかなり拝借しておりますし、配列のソートプログラムも以前どこかで教えて頂いたものです。クイックソートの方が早いのですが、長くなるので、バブルソートで済ませています。


以下コード。

Option Explicit
Sub InsertPictures()
  
  Dim fName As Variant
  Dim i As Long
  Dim Pict As Picture

  fName = Application.GetOpenFilename("JPGファイル, *.jpg", MultiSelect:=True)
  If IsArray(fName) Then
    Application.ScreenUpdating = False
    '配列に格納されたファイル名をソート
    BubbleSort fName, True
    For i = 1 To UBound(fName)
      Set Pict = ActiveSheet.Pictures.Insert(fName(i))
      With Pict
        .TopLeftCell = ActiveCell
        .ShapeRange.LockAspectRatio = msoTrue
        'どちらかをコメントアウト
        .ShapeRange.Height = ActiveCell.Height 'セルの高さリサイズ
        '.ShapeRange.Width = ActiveCell.Width 'セルの幅にリサイズ
        ActiveCell.Offset(0, 1) = fName(i) 'ファイル名書込み
      End With
      ActiveCell.Offset(2, 0).Activate
      Application.StatusBar = "処理中:" & i & "/" & UBound(fName) & "枚目"
    Next i
  End If
  With Application
    .StatusBar = False
    .ScreenUpdating = True
  End With
  Set Pict = Nothing
  MsgBox i & "枚の画像を挿入しました", vbInformation

End Sub

'値の入替え
Public Sub Swap(ByRef Dat1 As Variant, ByRef Dat2 As Variant)

  Dim varBuf As Variant
  varBuf = Dat1
  Dat1 = Dat2
  Dat2 = varBuf

End Sub

'配列のバブルソート
Public Sub BubbleSort(ByRef aryDat As Variant, _
  Optional ByVal SortAsc As Boolean = True)

  Dim i As Long
  Dim j As Long
  For i = LBound(aryDat) To UBound(aryDat) - 1
    For j = LBound(aryDat) To LBound(aryDat) + UBound(aryDat) - i - 1
      If aryDat(IIf(SortAsc, j, j + 1)) > aryDat(IIf(SortAsc, j + 1, j)) Then
        Call Swap(aryDat(j), aryDat(j + 1))
      End If
    Next j
  Next i

End Sub
    • good
    • 13
この回答へのお礼

ありがとうございます。
今朝、早速先週分の資料で試めさせていただきました。
定時後数時間、四苦八苦してこなしていた作業が30分ほどで完了しました。

画像貼りにへこたれていささか手抜きとなっていた所見等もこれからはじっくり書けそうです。

何より週末一人ぽつんと残業の憂き目を見なくてすみそうなのが嬉しいです。

お礼日時:2005/01/25 21:39

そのやりかたで、複数取り込めますよ。



「挿入」→「ファイルから」で画像を選ぶ時に
ctrlキーを押しながら入れたい写真を選べば
同時に選択できます。

また、マウスで複数の図を囲むようにドラッグしておいて
「挿入」ボタンを押す方法でもいいですし。
    • good
    • 10

本当に1点ずつ貼り付けているのですか? 私はマクロが使えないものですから以下の方法でやっています。

  そのまえに、「ツール」→「ユーザー設定」で「図形描画」のツールバーを常時表示させてください。また、エクセルはプレビューと実際の印刷にズレがでるので、私はワードを使っていますが、やり方はどちらも同じです。

<方法>
画像を選択する際には、何点でも一括選択( Shift または Ctrl を押しながら選択でも可)できますから、まずはエクセル上にまとめて貼り込みます。取り込む枚数はあまり多いと混乱しますので、私は1ページに貼り付ける枚数にあわせて20~30点ずつ取り込んでいます。

そのうえで「複数オブジェクトの選択」で「すべて選択」し、希望のサイズに一括で拡大/縮小します。ここから先は1点ずつ希望の位置に移動して並べてやらなければなりませんが、1点ずつ貼り付けるのに比べたら格段に早いはずです。 なお Excel の古いバージョンには機能が一部ないものもありますが、基本的には問題ないはずです。

それにしても、200枚も貼り付けてまともにExcelが動くのですか? 用途がわかりませんが、サムネイル程度の画質でいいのなら、アルバムソフトを使うと一発でできます。私はその場合、写真のインデックスとしてVixの「アルバム保存」機能を使っています。簡単な設定で1ページに載せる枚数も変えられるので、コンタクトプリント的に保存できて非常に重宝しています。

参考URL:http://www.katch.ne.jp/~k_okada/vixintro/
    • good
    • 3
この回答へのお礼

Shift または Ctrl を押しながら選択とやっているのですが、選択画面では色が反転して選択できているようにはなるのですが実際ワークシートには一枚しか貼られていない…等おもうにまかせませんでした。

200枚~というのは週末にまとめて上がってくる写真の枚数でして、実際各ファイルに貼る枚数は多くても20枚程度です。

お礼日時:2005/01/25 21:34

200枚もの画像をExcelに取り込むのは反対ですが、、、



やるとしたらマクロでしょう。
下記はサンプルです。

1.Excelで新規ブックを開く
2.ALT+F11でVBE画面を出す
3.VBE画面で挿入-標準モジュール
4.出てきたModule1に下記のコードをコピペ
5.VBE画面を閉じる
6.Excelのツール-マクロ-マクロで「Test」を実行
7.ファイル選択ダイアログでJPGファイルを選択(Shift or Ctrl で複数選択可)してOK

アクティブセルから1つ飛ばしで選択した画像を挿入します。
画像はセルの大きさに合わせます。

'---------------------------------------------------------------------
Sub Test()
Dim fName, pict As Picture
 fName = Application.GetOpenFilename("JPG, *.jpg", MultiSelect:=True)
 If IsArray(fName) Then
  For i = 1 To UBound(fName)
    Set pict = ActiveSheet.Pictures.Insert(fName(i))
    pict.TopLeftCell = ActiveCell
    pict.Width = ActiveCell.Width
    pict.Height = ActiveCell.Height
    ActiveCell.Offset(2, 0).Activate
  Next i
 End If
End Sub
'---------------------------------------------------------------------
    • good
    • 8
この回答へのお礼

ありがとうございます。

マクロなんて触ったことも無い私としては
手取り足取りといった解説がありがたい限りです。

おかげさまで今週末からは早く帰ることができそうです。

お礼日時:2005/01/25 21:28

最終的に紙に出すのであれば、写真だけ別のソフトで印刷すればよいのでは。


EXCEL上で楽は出来そうにありませんけど。
    • good
    • 3
この回答へのお礼

親会社から書面にエクセルファイルも添付でと
要求されているものですから…

お礼日時:2005/01/25 21:30

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

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

gooドクター

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

人気Q&Aランキング