Single spreadsheet image
If this is the only image in the worksheet, use the following code that turns the index 1 image into a grayscale.
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Planilha1")
ws.Shapes(1).PictureFormat.ColorType = msoPictureGrayscale
Or to select the desired image and then execute the code
Sub escalaCinza()
On Error GoTo err
Dim oImg As Shape
Dim ehImg As Boolean
Set oImg = ActiveWindow.Selection.ShapeRange(1)
If oImg.Type = msoPicture Or oImg.Type = msoLinkedPicture Then ehImg = True
If oImg.Type = msoPlaceholder Then
If oImg.PlaceholderFormat.ContainedType = msoPicture Or oImg.PlaceholderFormat.ContainedType = msoLinkedPicture Then
ehImg = True
End If
End If
If Not ehImg Then
err.Raise Number:=vbObjectError + 1000, Description:="Seleção não é imagem"
Exit Sub
End If
oImg.PictureFormat.ColorType = msoPictureGrayscale
Exit Sub
err:
MsgBox err.Description
End Sub
All images from a specific worksheet
Sub escalaCinza()
On Error GoTo err
Dim oImg As Shape
Dim ehImg As Boolean
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Planilha1")
For Each oImg In ws.Shapes
If oImg.Type = msoPicture Or oImg.Type = msoLinkedPicture Then ehImg = True
If oImg.Type = msoPlaceholder Then
If oImg.PlaceholderFormat.ContainedType = msoPicture Or oImg.PlaceholderFormat.ContainedType = msoLinkedPicture Then
ehImg = True
End If
End If
If Not ehImg Then
err.Raise Number:=vbObjectError + 1000, Description:="Seleção não é imagem"
Exit Sub
End If
oImg.PictureFormat.ColorType = msoPictureGrayscale
Next oImg
Exit Sub
err:
MsgBox err.Description
End Sub
All images in the Workbook
Sub escalaCinza()
On Error GoTo err
Dim oImg As Shape
Dim ehImg As Boolean
For Each ws In Worksheets
For Each oImg In ws.Shapes
If oImg.Type = msoPicture Or oImg.Type = msoLinkedPicture Then ehImg = True
If oImg.Type = msoPlaceholder Then
If oImg.PlaceholderFormat.ContainedType = msoPicture Or oImg.PlaceholderFormat.ContainedType = msoLinkedPicture Then
ehImg = True
End If
End If
If Not ehImg Then
err.Raise Number:=vbObjectError + 1000, Description:="Seleção não é imagem"
Exit Sub
End If
oImg.PictureFormat.ColorType = msoPictureGrayscale
Next oImg
Next ws
Exit Sub
err:
MsgBox err.Description
End Sub