読者です 読者をやめる 読者になる 読者になる

個人的業務用

Sub testsave()
Dim bSaveFlg As Boolean
Dim sShapeName As String
Dim sSavePath As String
Dim iCount As Integer
Dim sPath As String

    sSavePath = "C:\test\"
    

    For Each c In Selection
        sShapeName = c.Name
        iCount = iCount + 1
        sPath = sSavePath & Str(iCount) & ".jpeg"
        
        bSaveFlg = SaveClipToJpg(ActiveSheet.Shapes(sShapeName), sPath)
        If bSaveFlg = True Then
            MsgBox "保存に成功しました"
        Else
            MsgBox "保存に失敗しました"
        End If
        sPath = ""
    Next c

      
End Sub