Lighten Excel VBA Figure

0

Good afternoon. I need a macro to lighten a figure, located on the worksheet, and reverse coloration.

Excel does not record the macro when you change the settings in the "Format" tab. I've browsed Google from end to end as well.

Thank you very much.

    
asked by anonymous 14.09.2018 / 22:31

2 answers

0

Good morning @danieltakeshi.

It was not a single image. What I did was create a white rectangle with 30% transparency, there I recorded the macro passing it behind the figure. looks like this:

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

I was changing as I clicked on the figure, doing a type of "Filter".

    
17.09.2018 / 16:50
0

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
    
14.09.2018 / 22:51