Doubt in the execution sequence of the vba code

Asked

Viewed 38 times

-1

Hello I’m new around here,

I have two codes, one that searches the image by code, which runs instantly simulating a procv. And a macro that is executed in the change of the cell, to erase the first image and not overlap in the search of the second image. However it seems that it generates conflict and the image is erased without the search for the new image being carried out.

P.S. The two individually executed codes work perfectly, only need to be executed in sequence. Someone can help me?

First Code


Public Function getImage(ByVal sCode As String) As String

    On Error Resume Next ' Indica que no caso de erros de carregamento de imagem deve continuar executando a partir da próxima linha

    Dim sFile As String
    Dim oSheet As Worksheet
    Dim oCell As Range
    Dim oImage As Shape

    Set oCell = Application.Caller ' Célula onde a função foi chamada
    Set oSheet = oCell.Parent      ' Planilha que chamou a função
    
    

    
    ' Procura por uma imagem existente identificada pelo código (que precisa ser único!)
    Set oImage = Nothing
    For i = 1 To oSheet.Shapes.Count
        If oSheet.Shapes(i).Name = sCode Then
            Set oImage = oSheet.Shapes(i)
            Exit For
        End If
    Next i

        ' Se ainda não existir uma imagem com o código, carrega do arquivo e cria-a.
    ' A imagem já é posicionada na exata posição da célula onde a função foi chamada.

    If oImage Is Nothing Then

        sFile = "c:teste\" & sCode & ".jpg"
        Set oImage = oSheet.Shapes.AddPicture(sFile, msoCTrue, msoCTrue, oCell.Left, oCell.Top, oCell.Width, oCell.Height)

        If oImage Is Nothing Then ' Verifica se falhou o carregamento da imagem. Se falhou, adiciona a imagem genérica (com nome fixo)
            Set oImage = oSheet.Shapes.AddPicture("c:teste\inexistente.jpg", msoCTrue, msoCTrue, oCell.Left, oCell.Top, oCell.Width, oCell.Height)
        End If

        oImage.Name = sCode

    ' Caso contrário, se a imagem já existir, garante que ela se posiciona e cabe exatamente dentro da célula
    ' (apenas para o caso do usuário ter movido ou redimensionado manualmente a imagem sem querer)
    Else
        With oImage
            .Left = oCell.Left
            .Top = oCell.Top
            .Width = oCell.Width
            .Height = oCell.Height
        End With
    End If

    ' Retorna nada para a célula (afinal, esta é somente uma função de auxílio)
    getImage = ""

End Function

Second Code:

Sub ApagarImg1()

On Error Resume Next
Dim img As Object 'Era antes "As Shape"

For Each img In ActiveSheet.Pictures 'Era antes ".Shape"
    If Not Application.Intersect(img.TopLeftCell, ActiveSheet.Range("c5")) Is Nothing Then 'seleciona a área da imagem
        
        img.Delete
              
    End If
   
Next

End Sub
  • Avoid using uppercase letters in sentences, as in the title for example. https://pt.meta.stackoverflow.com/questions/5483/manual-de-como-n%C3%83o-fazer-perguntas/5505#5505

  • did the editing...

1 answer

1

Just do a third function by calling these two in the sequence you wish.

Sub chamaSubFunc() Call getimg() Call apagaimg() End sub

Or you can still call apagaimg() at the end of your getimg works block, before closing it.

  • There is a (Sub deleteImg1.......deleteImg10) if I put all at the end of (Function) all images will be deleted when executing the code. Need to be run separately. I’ve also performed a third Sub calling the two equally you spoke though, the execution goes through the two codes and only cleans the Image cell. Mine.

  • I also tried to make a Sub Delay, delaying the execution of the second, also did not succeed...

Browser other questions tagged

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