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