Inserimento immagini dinamiche in Excel 2007

Come ti posso ringraziare?

Un grazie fa sempre piacere ed è più sufficiente.

Andrea.

Come ti posso ringraziare?

Ciao Andrea,

ecco i file:

cartella immagini dinamiche

Fammi sapere,

grazie,

Alessio.

Ciao Alessio,

nel tuo file utilizzi un controllo immagine Activex, ecco perché non funzionava a dovere. Ecco che cosa devi fare:

• nel tuo file cancella i due controlli (immagini)
• sostituisci il codice con il quello allegato

Andrea.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim sPathName As String, sFileName As String, sPicName As String, sPicAddr As String

Dim LarghezzaInCentimetri As Single

  If Intersect(Target, Range("a1,aj14")) Is Nothing Then Exit Sub

  '--- il nome dell'immagine è composto così:

  '--- 'Immagine' + indirizzo cella destinazione es: ImmagineA1, ImmagineAJ14

  With Target

    sPathName = ThisWorkbook.Path & ""

    sPicName = CStr(.Value)

    If Len(sPicName) Then

      If .Address(0, 0) = "A1" Then

        sPicAddr = "B10"

        sFileName = sPathName & .Value & ".jpg"

        sPicName = "Immagine" & sPicAddr

        LarghezzaInCentimetri = 5

      ElseIf .Address(0, 0) = "AJ14" Then

        sPicAddr = "V10"

        sFileName = sPathName & .Value & ".jpg"

        sPicName = "Immagine" & sPicAddr

        LarghezzaInCentimetri = 5

      End If

    End If

  End With

  '--- carica immagine, se esiste il file, nella posizione stabilita e ridimensionala

  If Len(Dir(sFileName)) Then

    On Error Resume Next

     Me.Shapes(sPicName).Delete

    On Error GoTo 0

    With Me.Pictures.Insert(sFileName)

      .Name = sPicName

      .Top = Range(sPicAddr).Top

      .Left = Range(sPicAddr).Left

      .ShapeRange.LockAspectRatio = msoTrue

      .Width = Application.CentimetersToPoints(LarghezzaInCentimetri)

    End With

  End If

End Sub

Ciao Andrea,

ecco i file:

cartella immagini dinamiche

Fammi sapere,

grazie,

Alessio.