No seguimento desta pergunta:
http://pt.stackoverflow.com/a/112899/13237

Código:

    Function PrinciQualidade14(LNumber As Integer) As String
    
        If LNumber < 15 And LNumber > 0 Then
        InsertPictureInRange LNumber, Application.ActiveCell
        Else
        Debug.Print "Numero incorreto"
        End If
        PrinciQualidade14 = LNumber
        Exit Function
    End Function
    
    Sub InsertPictureInRange(LNumber As Integer, TargetCells As Range)
    ' inserts a picture and resizes it to fit the TargetCells range
        Dim p As Object
        Dim t As Double, l As Double, w As Double, h As Double
        Dim texto As String, PictureFileName As String
        Dim commentBox As Comment
    
       Select Case LNumber
       Case Is = 1
            PictureFileName = "C:\Users\" & Environ("USERNAME") & "\AppData\Roaming\Microsoft\AddIns\14_Q_Basics_img\1.png"
            texto = "11111111111"
       Case Is = 2
            PictureFileName = "C:\Users\" & Environ("USERNAME") & "\AppData\Roaming\Microsoft\AddIns\14_Q_Basics_img\2.png"
            texto = "22222222222222"
       Case Is = 3
            PictureFileName = "C:\Users\" & Environ("USERNAME") & "\AppData\Roaming\Microsoft\AddIns\14_Q_Basics_img\3.png"
            texto = "3333333333"
       Case Is = 4
            PictureFileName = "C:\Users\" & Environ("USERNAME") & "\AppData\Roaming\Microsoft\AddIns\14_Q_Basics_img\4.png"
            texto = "4444444444444"
       Case Is = 5
            PictureFileName = "C:\Users\" & Environ("USERNAME") & "\AppData\Roaming\Microsoft\AddIns\14_Q_Basics_img\5.png"
            texto = "555555555555555"
       Case Is = 6
            PictureFileName = "C:\Users\" & Environ("USERNAME") & "\AppData\Roaming\Microsoft\AddIns\14_Q_Basics_img\6.png"
            texto = "66666666666"
       Case Is = 7
            PictureFileName = "C:\Users\" & Environ("USERNAME") & "\AppData\Roaming\Microsoft\AddIns\14_Q_Basics_img\7.png"
            texto = "777777777"
       Case Is = 8
            PictureFileName = "C:\Users\" & Environ("USERNAME") & "\AppData\Roaming\Microsoft\AddIns\14_Q_Basics_img\8.png"
            texto = "888888888"
       Case Is = 9
            PictureFileName = "C:\Users\" & Environ("USERNAME") & "\AppData\Roaming\Microsoft\AddIns\14_Q_Basics_img\9.png"
            texto = "9999999999"
       Case Is = 10
            PictureFileName = "C:\Users\" & Environ("USERNAME") & "\AppData\Roaming\Microsoft\AddIns\14_Q_Basics_img\10.png"
            texto = "1000000000"
       Case Is = 11
            PictureFileName = "C:\Users\" & Environ("USERNAME") & "\AppData\Roaming\Microsoft\AddIns\14_Q_Basics_img\11.png"
            texto = "111111111"
       Case Is = 12
            PictureFileName = "C:\Users\" & Environ("USERNAME") & "\AppData\Roaming\Microsoft\AddIns\14_Q_Basics_img\12.png"
            texto = "12222222222222"
       Case Is = 13
            PictureFileName = "C:\Users\" & Environ("USERNAME") & "\AppData\Roaming\Microsoft\AddIns\14_Q_Basics_img\13.png"
            texto = "1333333333333"
       Case Is = 14
            PictureFileName = "C:\Users\" & Environ("USERNAME") & "\AppData\Roaming\Microsoft\AddIns\14_Q_Basics_img\14.png"
            texto = "14444444444444"
    
       Case Else
          Debug.Print "numero errado"
    
       End Select
    
    
        If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
        If Dir(PictureFileName) = "" Then Exit Sub
        ' import picture
        '@parmetros
        'PictureFileName - diretoria ficheiro
        'false - copy image
        'true - break link com a imagem
        Set p = ActiveSheet.Shapes.AddPicture(PictureFileName, False, True, 0, 0, -1, -1)
    
    
        ' determine positions
        With TargetCells
            .HorizontalAlignment = xlCenter
            t = .Top
            l = .Left
            w = .Offset(0, .Columns.Count).Left - .Left
            h = .Offset(.Rows.Count, 0).Top - .Top
        End With
    
        'add comment
        Application.ActiveCell.ClearComments
    
        Set commentBox = Application.ActiveCell.AddComment
        With commentBox
        .Text Text:=texto
        ' Set the visible to True when you always want the image displayed, and
        ' to False when you want it displayed only when you click on the cell.
        .Visible = False
      End With
    
    
        ' position picture
        With p
    
            .Top = t
            .Left = l
            .Width = w
            .Height = h
            .Placement = 1
        End With
        TargetCells.ClearContents
        Set p = Nothing
    End Sub

Este código possui um erro que é, sempre que início o ficheiro Excel, a célula que estiver selecionada vai receber o valor e todas as funções que tiverem presentes no ficheiro.

Exemplo:
a função `PrinciQualidade14` tem como parâmetro de entrada um inteiro e devolve a imagem correspondente a esse numero(devolve na célula onde foi chamado)

Problema:
Eu chamo a função 4x

    CELL B1=PrinciQualidade14(2)
    CELL B2=PrinciQualidade14(12)
    CELL B3=PrinciQualidade14(6)
    CELL B4=PrinciQualidade14(1)

Quando voltar a abrir o excel vai acontecer isto(sem fazer nada):

    CELL A1=PrinciQualidade14(2); PrinciQualidade14(12); PrinciQualidade14(6); PrinciQualidade14(1)


Alguma ideia para solucionar este problema?

Obrigado


**Update**

Repetição das imagens:
[![inserir a descrição da imagem aqui][1]][1]
 

Estranho que eu não consigo reproduzir o erro, simplesmente acontece.
Normalmente é sempre que dentro da mesma celula mexo um pouco a img para os lados quando voltar a abrir o ficheiro vai duplicar(nem sempre acontece).

Outro ponto estranho que não sei se é normal é a função ser chamada n vezes(n = a nº de vezes que  a função é usada no ficheiro).
Inseri este código olha o resultado:

    flag = HASpic(Application.Caller)
       If flag Then
            Debug.Print "Já tem picture"
            PrinciQualidade14 = iNumero
            Exit Function
       Else
            Debug.Print "pumba picture"
            If iNumero > 0 And iNumero < 15 Then
                InserirImagem iNumero, Application.Caller
            Else
                Debug.Print "Numero incorreto"
            End If
        End If 


Resultado:

    Já tem picture
    Já tem picture
    Já tem picture
    Já tem picture
    Já tem picture
    Já tem picture
    Já tem picture
    Já tem picture
    Já tem picture
    picture
    Valor: $F$5
    Já tem picture
    Já tem picture
    picture
    Valor: $F$2

  [1]: https://i.sstatic.net/iibel.png