Skip to main content
adicionou 1560 caracteres ao conteúdo
Fonte Link
Lucio Rubens
  • 3,4mil
  • 13
  • 22

Utilize o Application.Caller, que retorna a célula em que a função foi chamada.

Substitua esse trecho:

InsertPictureInRange LNumber, Application.ActiveCell

Por este:

InsertPictureInRange LNumber, Application.Caller

Em parte, segue ajuste do seu código:

Function PrinciQualidade(iNumero As Integer) As String

    If iNumero > 0 And iNumero < 15 Then
        InserirImagem iNumero, Application.Caller
    Else
        Debug.Print "Numero incorreto"
    End If
    
    PrinciQualidade14 = LNumber
End Function

Sub InserirImagem(iNumero As Integer, rCelulaDestino As Range)
    Dim sCaminhoBase As String, sNomeUsuario As String
    Dim matrizComentario As Variant
    Dim oImagem As Object

    sCaminho = Environ("AppData") & "\Microsoft\AddIns\14_Q_Basics_img\"
    sImagem = sCaminho & iNumero & ".png"
    matrizComentario = Array("111", "222", "333", "444", "555", "666", "777", "888", "999", "10000", "11111", "122222", "1333", "1444")
    
    If Dir(sImagem) = "" Then Exit Sub
    
    Set oImagem = ActiveSheet.Shapes.AddPicture(sImagem, False, True, 0, 0, -1, -1)
    
    With rCelulaDestino
        .HorizontalAlignment = xlCenter
        .ClearComments
        .AddComment matrizComentario(iNumero - 1)
        .Comment.Visible = False
        .ClearContents
    End With
    
    With oImagem
        .Top = rCelulaDestino.Top
        .Left = rCelulaDestino.Left
        .Width = rCelula.Width
        .Height = rCelulaDestino.Height
        .Placement = 1
    End With
    
End Sub

Utilize o Application.Caller, que retorna a célula em que a função foi chamada.

Substitua esse trecho:

InsertPictureInRange LNumber, Application.ActiveCell

Por este:

InsertPictureInRange LNumber, Application.Caller

Utilize o Application.Caller, que retorna a célula em que a função foi chamada.

Substitua esse trecho:

InsertPictureInRange LNumber, Application.ActiveCell

Por este:

InsertPictureInRange LNumber, Application.Caller

Em parte, segue ajuste do seu código:

Function PrinciQualidade(iNumero As Integer) As String

    If iNumero > 0 And iNumero < 15 Then
        InserirImagem iNumero, Application.Caller
    Else
        Debug.Print "Numero incorreto"
    End If
    
    PrinciQualidade14 = LNumber
End Function

Sub InserirImagem(iNumero As Integer, rCelulaDestino As Range)
    Dim sCaminhoBase As String, sNomeUsuario As String
    Dim matrizComentario As Variant
    Dim oImagem As Object

    sCaminho = Environ("AppData") & "\Microsoft\AddIns\14_Q_Basics_img\"
    sImagem = sCaminho & iNumero & ".png"
    matrizComentario = Array("111", "222", "333", "444", "555", "666", "777", "888", "999", "10000", "11111", "122222", "1333", "1444")
    
    If Dir(sImagem) = "" Then Exit Sub
    
    Set oImagem = ActiveSheet.Shapes.AddPicture(sImagem, False, True, 0, 0, -1, -1)
    
    With rCelulaDestino
        .HorizontalAlignment = xlCenter
        .ClearComments
        .AddComment matrizComentario(iNumero - 1)
        .Comment.Visible = False
        .ClearContents
    End With
    
    With oImagem
        .Top = rCelulaDestino.Top
        .Left = rCelulaDestino.Left
        .Width = rCelula.Width
        .Height = rCelulaDestino.Height
        .Placement = 1
    End With
    
End Sub
Fonte Link
Lucio Rubens
  • 3,4mil
  • 13
  • 22

Utilize o Application.Caller, que retorna a célula em que a função foi chamada.

Substitua esse trecho:

InsertPictureInRange LNumber, Application.ActiveCell

Por este:

InsertPictureInRange LNumber, Application.Caller