EXCELに写真ファイルを取込、写真のリンクを図に変更するVBA | システムエンジニアライフ

EXCELに写真ファイルを取込、写真のリンクを図に変更するVBA

ヘッダー広告
スポンサードリンク

先週は1週間スマホアプリのテストを行っておりました。
ケース数がかなり多かったのですが、毎日終電近くまでテストを対応してやっと終わりつつあります。

テストはiPhone、Androidで行ったのですが、実際にスマホを使用してテストしている時間よりも、終わったあとのテスト結果(エビデンス)をまとめる作業に多くの時間を費やしました。
特にスマホ端末で取得したスクリーンショットをEXCELに張り付ける必要があったのですが、EXCELでは一つ一つでしか写真を張り付けられないので、このままではかなり無駄な時間を使ってしまうと考えて、VBAを作成しました。

今回は同じような状況の方々が少しでも作業負担を減らせるとよいなぁと思い、そのVBAをご紹介させていただたいと思います。

複数の写真をEXCELシートに選択して張り付ける

まずは複数の写真ファイルを選択して、一気に張り付けるVBAです。
早速コードをご紹介します。

Public Sub PastePicture()
'複数の写真を同時に取り込む

    Dim FileDia As FileDialog
    Dim FileCount As Long
    Dim i As Long
    Dim Pic As Shape
    
    Const FileExtensions  As String = "写真ファイル"
    Const FileType As String = "*.png"  '写真の拡張子を選択 JPG等に変更も可能
    'Const FileType As String = "*.jpg"
    Const MsgTitle As String = "取込対象ファイルを選択して下さい"
    
    Const PicWidth As Single = 300  '写真の横幅を指定
    Const PicHeight As Single = 500  '写真の縦幅をを指定
        
    '取込ファイル選択
    Set FileDia = Application.FileDialog(msoFileDialogFilePicker)
       
    With FileDia
        .Title = MsgTitle
        
        .Filters.Clear
        .Filters.Add FileExtensions, FileType
        .FilterIndex = 1
            
        .InitialView = msoFileDialogViewDetails
        .AllowMultiSelect = True
    
        If .Show = -1 Then

            '取込処理開始
            FileCount = .SelectedItems.Count
            For i = 1 To FileCount
                Application.StatusBar = i & "/" & FileCount & "ファイルを貼り付け中です。"
                
                Set Pic = ActiveSheet.Shapes.AddPicture( _
                                                    Filename:=.SelectedItems(i), _
                                                    LinkToFile:=False, _
                                                    SaveWithDocument:=True, _
                                                    Left:=Selection.Left, _
                                                    Top:=Selection.Top, _
                                                    Width:=PicWidth, _
                                                    Height:=PicHeight)
                                                    
                '写真のサイズを変更する
                With Pic
                    .ScaleHeight 0.5, msoFalse
                    .ScaleWidth 0.5, msoFalse
                End With
                
            Next i
    
        Else
            MsgBox "処理を中断します。", vbInformation, "処理中断"
            Exit Sub
        End If
    End With
  
    Set FileDia = Nothing

End Sub

上記プロシージャを起動すると、ファイル選択画面が表示されるので、取り込みたい写真ファイルを選択すると、選択しているシートに一気に写真が挿入されます。
これで一つ一つの写真をEXCELに取り込むというかなり手間のかかる作業が短縮されるのではないかと思います。

リンクの写真を図に変更

次にリンクの写真を図に変更する方法です。

Shapes.AddPictureで、LinkToFile:=Trueに指定してしまったり、ハイパーリンクで写真を張り付けてしまって、他の人がファイルを開いたときに、リンク切れになってしまうというトラップを解消する方法です。
私も今回のテストではこのトラップにひっかかり、何十枚と貼り付けた後に気が付きましたが、何とか解消出来ました。

Public Sub LinkToShape()
'写真をリンクで張り付けてしまった場合にリンク→図に変更する

    Dim Shp As Shape
    
    For Each Shp In ActiveSheet.Shapes
        'オートシェイプがリンクの写真の場合
        If Shp.Type = msoLinkedPicture Then

            Shp.Copy
            ActiveSheet.PasteSpecial Format:="図(JPEG)", Link:=False
            Shp.Delete
        
        End If
    Next

End Sub

こちらのプロシージャを起動すると、リンクの写真が自動で図に変換されて貼りなおされます。
今回私がはまったようなEXCELの罠を解消する際にご使用ください。

以上、簡単ではございますが、EXCELで写真ファイルを扱うVBAの一部を紹介しました。
SEの方々はEXCELに写真ファイルをペタペタと貼り付けることが多々あるかと思いますので、是非参考にしていただき、日々の開発に役立てていただければと思います。
システムエンジニアのみなさんお互い頑張りましょう!

フッター広告

スポンサードリンク



シェアする

  • このエントリーをはてなブックマークに追加

フォローする