[[20170110140904]]　『エクセル2010で写真を取り込み下のセルにファイル』（ナツミサ）　ページの最後に飛ぶ

『エクセル2010で写真を取り込み下のセルにファイル名と撮影日を表示したい』（ナツミサ）

いつも拝見させていただき勉強させていただいております。
現在、エクセル2010で社員証を作成するために台帳と言うシートにコマンドボタンを配置しボタンを押すと（E13：J27)を結合したセル（E13）に写真を挿入し、枠で囲み、(F28:G28)を結合したセル（F28）にファイル名、(I28:J28)を結合したセル（I28）に撮影日を表示させる為、会社の上司と励んでおりましたが、年末に事故で他界してしまい自分はマクロ初心者の為、現在、作業が止まってしまい新任の上司から催促され困っております。以前、古いエクセルで作成していたものを参考に、写真を挿入することは出来ましたが、写真のサイズを自動でE13の結合セルより少し小さくしたいのと、ファイル名の取得と、撮影日の取得が出来ないのでご教授お願いいたします。今後、後任の担当に引き継ぐ可能性もある為、この行は何を設定している等とコメント頂ければ大変助かります。乱筆乱文、無理を申しますが何卒よろしくご教授お願いいたします。

標準モジュール１に記入しました。
Sub 写真挿入()
Range("E13").Select

    ActiveSheet.Unprotect
    Dim BooX As Boolean
    BooX = Application.Dialogs(xlDialogInsertPicture).Show
    If BooX = False Then Exit Sub
    Selection.ShapeRange.IncrementLeft 7
    Selection.ShapeRange.IncrementTop 10
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.Height = 185#
    Selection.ShapeRange.Width = 310#
    Selection.ShapeRange.Line.Weight = 2#
    Selection.ShapeRange.Line.Visible = msoTrue
    Selection.ShapeRange.Line.Style = msoLineSingle

End Sub
　

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

行毎の解説はしません。ご自身で検索し、調べてください。自分で調べないと、何も身につきませんよ。
また、このままだとプロテクト解除したまま終わってしまうのですが、よろしいのでしょうか？

 Sub 写真挿入()
    Const iSPC = 10
    Dim BooX As Boolean

    ActiveSheet.Unprotect
    BooX = Application.Dialogs(xlDialogInsertPicture).Show
    If BooX = False Then Exit Sub

    With Range("E13:J27")
        Selection.ShapeRange.IncrementLeft 7
        Selection.ShapeRange.IncrementTop 10
        Selection.ShapeRange.LockAspectRatio = msoFalse
        Selection.ShapeRange.Top = .Top + iSPC
        Selection.ShapeRange.Left = .Left + iSPC
        Selection.ShapeRange.Width = .Width - iSPC * 2
        Selection.ShapeRange.Height = .Height - iSPC * 2
        Selection.ShapeRange.Line.Weight = 2#
        Selection.ShapeRange.Line.Visible = msoTrue
        Selection.ShapeRange.Line.Style = msoLineSingle
    End With
 End Sub
（???） 2017/01/10(火) 17:09

あと、撮影日は困りましたね。ダイアログに貼らせてしまうと、元ファイルの情報が得られないのです。
普通のファイルを開くダイアログを使い、ファイル名を得て、マクロ自身でファイル情報を調べてから貼り付けるように変えるとかですかねぇ。
（???） 2017/01/10(火) 17:14

というわけで、普通のファイルを開くダイアログに変更してみた例なぞ。
なお、JPEG形式等の撮影日タグを取り出すのは面倒なので、とりあえずファイルの更新日付を使いました。

 Sub test()
    Const iSPCX = 7
    Const iSPCY = 10
    Dim cFile As String

    With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = CreateObject("Shell.Application").Namespace(39).Self.Path & "\"
        If .Show = True Then
            cFile = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With

    ActiveSheet.Unprotect
    With Range("E13:j27")
        ActiveSheet.Shapes.AddPicture cFile, msoFalse, msoTrue, .Left + iSPCX, .Top + iSPCY, .Width - iSPCX * 2, .Height - iSPCY * 2
    End With
    With ActiveSheet.Pictures(ActiveSheet.Pictures.Count)
        .ShapeRange.LockAspectRatio = msoFalse
        .ShapeRange.Line.Weight = 2#
        .ShapeRange.Line.Visible = msoTrue
        .ShapeRange.Line.Style = msoLineSingle
    End With

    ActiveSheet.Range("F28") = Mid(cFile, InStrRev(cFile, "\") + 1)
    ActiveSheet.Range("I28") = FileDateTime(cFile)
    ActiveSheet.Protect
 End Sub
（???） 2017/01/10(火) 17:45

早速、回答を頂きありがとうございます。昨晩から出張でしたので返答が遅れ申し訳ありません。
素晴らしいです、やりたいことか出来ました。動作させる所を上司と確認したら感動しておりました。
これを機に、勉強してレベルアップしたいと思います、ありがとうございました！

（ナツミサ） 2017/01/11(水) 11:48

コメント返信：

[ 一覧(最新更新順) ]

[[20170110140904]] 『エクセル2010で写真を取り込み下のセルにファイル』（ナツミサ） ページの最後に飛ぶ

[[20170110140904]]　『エクセル2010で写真を取り込み下のセルにファイル』（ナツミサ）　ページの最後に飛ぶ