Whiten figure VBA Excel

Asked

Viewed 131 times

0

Good afternoon. I need a macro to clear a figure, located in the spreadsheet, and reverse the coloring.

Excel does not save the macro when I change the settings in the "Format" tab. I have already searched Google also end to end.

Thank you so much.

excel vba

  • When you clear, which path in the format menu? Which tool exactly is used?

  • @danieltakeshi am using Microsoft Excel 2016. I use the "Format" tab, which appears when I click on the figure, I go in "Color" and choose the option "Grayscale".

2 answers

0


Good morning @danieltakeshi.

It wasn’t a single image. What I did was create a white rectangle with 30% transparency, and then I recorded the macro by moving it behind the figure. got that way: 

ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select
Selection.ShapeRange.ZOrder msoSendToBack 
ActiveSheet.Shapes.Range(Array("Picture 4")).Select
Selection.ShapeRange.ZOrder msoSendToBack
ActiveSheet.Shapes.Range(Array("Group 14")).Select
Selection.ShapeRange.ZOrder msoSendToBack
ActiveSheet.Shapes.Range(Array("Picture 3")).Select
Selection.ShapeRange.ZOrder msoSendToBack

It was changing as I clicked on the picture, making a kind of "Filter".

0

Single image of the spreadsheet

If it is the only image of the worksheet, use the following code that transforms the index 1 image to grayscale.

Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Planilha1")
ws.Shapes(1).PictureFormat.ColorType = msoPictureGrayscale

Or to select the desired image and then run 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 from 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

Browser other questions tagged excel vba

You are not signed in. Login or sign up in order to post.