個人的業務用
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