エクセルシート上の画像のファイル名とセル位置の隣に入力し保存するマクロ

get_image_path_and_current_cell.bas

Attribute VB_Name = "Module1"
Sub get_image_path_and_current_cell()
    Dim pic As Shape, TCht  As Object
    Dim ACWidth   As Long, ACHeight As Long
    For Each pic In ActiveSheet.Shapes
        Debug.Print (pic.AlternativeText)
        Range(pic.TopLeftCell.Address).Offset(0, 1) = pic.AlternativeText
        ACWidth = pic.Width
        ACHeight = pic.Height
        TCht.Paste
        TCht.Export Filename:=ThisWorkbook.Path & "\new_pic\" & pic.AlternativeText, filtername:="PNG"
        TCht.Parent.Delete
        Debug.Print (pic.TopLeftCell.Address)
    Next
End Sub

https://umihico.wordpress.com/2018/05/16/%E3%82%A8%E3%82%AF%E3%82%BB%E3%83%AB%E4%B8%8A%E3%81%AE%E5%A4%A7%E9%87%8F%E3%81%AE%E7%94%BB%E5%83%8F%E3%81%AE%E5%85%83%E3%83%91%E3%82%B9%E3%81%A8%E3%82%BB%E3%83%AB%E4%BD%8D%E7%BD%AE%E3%82%92%E8%AA%BF/