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