macro visulizza immagini

Hai un problema con Excel?

Nuova discussione

macro visulizza immagini
di Michele (utente non iscritto) data: 18/11/2016 10:32:59
devo creare un listino che visualizza l'immagine corrispondente al codice a barre.
la macro che ho inserito funziona solo digitando o copiando un codice a barre per volta, non funziona se si incollano più codici insieme.

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim rng As Range
    Dim shp As Shape
    Dim bln As Boolean
    Set rng = Me.Range("A2:A3500")
    
    If Not Intersect(Target, rng) Is Nothing Then
        If Target.Cells.Count > 1 Then Exit Sub
        If Target.Value <> "" Then
            For Each shp In Me.Shapes
                If shp.Top = Target.Offset(0, 7).Top Then
                    If shp.Left = Target.Offset(0, 7).Left Then
                        shp.Delete
                    End If
                End If
            Next
           
            ActiveSheet.Pictures.Insert( _
                ThisWorkbook.Path & "Immagini" & _
                    Application.WorksheetFunction.VLookup(Target.Value, [Articoli], 7, 0)).Select
            
          
            
            Selection.Top = Target.Offset(0, 7).Top
            Selection.Left = Target.Offset(0, 7).Left
        Else
            For Each shp In Me.Shapes
                If shp.Top = Target.Offset(0, 7).Top Then
                    If shp.Left = Target.Offset(0, 7).Left Then
                        shp.Delete
                    End If
                End If
            Next
        End If
    End If
    
    Target.Select
    
    Set rng = Nothing

End Sub

di Luca73 data: 18/11/2016 11:19:37
Prova a modificare così

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim rng As Range
    Dim shp As Shape
    Dim bln As Boolean
    Dim TargetRed As Range
    Set rng = Me.Range("A2:A3500")
    
    If Not Intersect(Target, rng) Is Nothing Then
        'If Target.Cells.Count > 1 Then Exit Sub
        For Each TargetRed In Target
        If TargetRed.Value <> "" Then
            For Each shp In Me.Shapes
                If shp.Top = TargetRed.Offset(0, 7).Top Then
                    If shp.Left = TargetRed.Offset(0, 7).Left Then
                        shp.Delete
                    End If
                End If
            Next
           
            ActiveSheet.Pictures.Insert( _
                ThisWorkbook.Path & "Immagini" & _
                    Application.WorksheetFunction.VLookup(TargetRed.Value, [Articoli], 7, 0)).Select
            
          
            
            Selection.Top = TargetRed.Offset(0, 7).Top
            Selection.Left = TargetRed.Offset(0, 7).Left
        Else
            For Each shp In Me.Shapes
                If shp.Top = TargetRed.Offset(0, 7).Top Then
                    If shp.Left = TargetRed.Offset(0, 7).Left Then
                        shp.Delete
                    End If
                End If
            Next
        End If
    Next TargetRed
End If

    Target.Select
    
    Set rng = Nothing

End Sub

di patel data: 18/11/2016 11:24:23
la macro è nata per funzionare così, forse preferisci avere un pulsante che che inserisce le immagini dopo aver completato la colonna A ?
di Michele (utente non iscritto) data: 18/11/2016 15:50:20
la soluzione indicata da Luca sembra funzionare.

Patel potrebbe interessarmi anche la tua soluzione.

di patel data: 19/11/2016 10:19:40
prova questa selezionando in colonna A i nomi delle immagini da inserire

Sub immagini()
    
    Dim rng As Range
    Dim shp As Shape
    Dim bln As Boolean
    Dim TargetRed As Range
    For Each TargetRed In Selection
        If TargetRed.Value <> "" Then
            For Each shp In ActiveSheet.Shapes
                If shp.Top = TargetRed.Offset(0, 7).Top Then
                    If shp.Left = TargetRed.Offset(0, 7).Left Then
                        shp.Delete
                    End If
                End If
            Next
            ActiveSheet.Pictures.Insert( _
                ThisWorkbook.Path & "Immagini" & _
                    Application.WorksheetFunction.VLookup(TargetRed.Value, [Articoli], 7, 0)).Select
            Selection.Top = TargetRed.Offset(0, 7).Top
            Selection.Left = TargetRed.Offset(0, 7).Left
        Else
            For Each shp In ActiveSheet.Shapes
                If shp.Top = TargetRed.Offset(0, 7).Top Then
                    If shp.Left = TargetRed.Offset(0, 7).Left Then
                        shp.Delete
                    End If
                End If
            Next
        End If
    Next TargetRed
End Sub

di Michele (utente non iscritto) data: 21/11/2016 21:40:10
Patel, la soluzione proposta non funziona.
di patel data: 22/11/2016 08:43:18
allega un file con i dati e spiega bene cosa vuoi ottenere, il file già allegato è vuoto
di mb data: 22/11/2016 10:02:26
Ciao Michele e ciao Patel a me funziona

ti allego il file utilizzato con i tuoi dati
di Michele (utente non iscritto) data: 23/11/2016 18:57:17
Il file allegato da mb funziona, così come la soluzione indicata da Luca73.
Per Patel allego il file ordine cliente e la cartella contenente le immagini.
Nel foglio articoli del file ordine cliente sono elencati degli articoli con barcode, descrizioni varie, prezzo e nome delle immagini contenute nella cartella apposita.
Voglio ottenere la visualizzazione delle immagini relative agli articoli nella colonna H del foglio ordine del file ordine cliente se copio contemporaneamente i codici ean nella colonna A del foglio ordine del file ordine cliente.
di patel data: 23/11/2016 20:21:51
a me il problema sembra già risolto da Luca73, non capisco perché sei interessato ad una soluzione diversa
di Michele (utente non iscritto) data: 24/11/2016 10:44:02
Patel semplicemente perchè tu avevi proposto una soluzione diversa. In ogni caso grazie.
di patel data: 24/11/2016 11:31:32
comunque io ho testato sul tuo allegato la macro che avevo postato e funziona perfettamente, naturalmente occorre eliminare quella di luca73, non possono coesistere ed eliminare tutti gli option explicit perché ci sono variabili non dichiarate

Vuoi Approfondire?