418 Aufrufe
Gefragt in Tabellenkalkulation von
Was ist falsch oder fehlt ?  Mein Code:

Sub BilderEinfuegen()
   Dim bytBild As Byte
   Dim arrBereiche
   Windows("EAN Stickers Blanco.xlsm").Activate
    Sheets("qryFelgenDaten1").Activate
   Dim Datei As Range      ' \\Shared Folders\Company\EAN\U-Titansilber\U7517\U7517365044423.jpg -
   Set Datei = Range("L2")

     Sheets("Blanco").Activate
    
   arrBereiche = Array("G12:G15")
   Application.ScreenUpdating = True
   With Application.FileDialog(msoFileDialogFilePicker)
      .AllowMultiSelect = True
         

      .InitialFileName = Datei
      .ButtonName = "OK"
      .Title = "Bilderauswahl"
      .Show     '`***** hier das Problem  wenn .Show aktiviert :dann wird der Pfad mit der entsprechenden Datei angezeigt
                ' und bei drücken Enter auch korrekt eingesetzt , auch die weiteren anderen JPG´s  !
                ' wenn ich .Show weglasse : dann wird ohne Nachfrage das erste JPG eingesetzt **** was so gewollt ist
                ' - jedoch alle weiteren JPG´s sind dann ebenfalls alle das gleich Bild !
     
         For bytBild = 1 To .SelectedItems.Count
         Sheets("Blanco").Activate
            ActiveSheet.Pictures.Insert .SelectedItems(bytBild)
            With ActiveSheet.Pictures(ActiveSheet.Pictures.Count)
               .Top = Range(arrBereiche(bytBild - 1)).Top
               .Left = Range(arrBereiche(bytBild - 1)).Left
               .Width = Range(arrBereiche(bytBild - 1)).Width
            End With
         Next bytBild
      
   End With
         Windows("EAN Stickers Blanco.xlsm").Activate

 Application.ScreenUpdating = True
End Sub

7 Antworten

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)

Hallo,

hier mal ein kleines Beispiel, wie so etwas aussehen kann:

Sub bilder_einfuegen()

Dim fd As FileDialog
Dim vrtSelectedItem As Variant          'Variable für die ausgewählten Bilder
Dim lngZeile As Long

'Filedialogobjekt wird erstellt
Set fd = Application.FileDialog(msoFileDialogFilePicker)

With fd
   'nur Bilder mit Endung jpg und jpeg öffnen
   .Filters.Add "Bilder", "*.jpg; *.jpeg", 1
   'FileDialog wird angezeigt und User hat Öffnen-Button gedrückt
   If .Show = -1 Then
      'nun ausgewählte Bilder einfügen
       For Each vrtSelectedItem In .SelectedItems
            'Einfügezeile festlegen
            lngZeile = lngZeile + 10
            'Bild wird in Spalte G der Einfügezeile in Breite 160 und Höhe 120 eingefügt
            Worksheets("Blanco").Shapes.AddPicture vrtSelectedItem, msoFalse, msoTrue, Cells(lngZeile, 7).Left, Cells(lngZeile, 7).Top, 160, 120
       Next vrtSelectedItem
   End If
 End With
 
'Filedialogbjekt wird auf Nothing gestellt
Set fd = Nothing
    
End Sub

Gruß

M.O.

0 Punkte
Beantwortet von

Vielen Dank für den Code - funktioniert allerdings nur genauso wie meine zuvor angezeigte Lösung. Sobald

.Show  aktiviert ist muss ich per Button OK bestätigen - das funktioniert Alles schon wie bisher !  Ich würde aber gerne die JPG direkt in das entspr. Feld in Sheet Blanco einfügen - ohne vorher OK bestätigen zu müssen.!

Ich nehme die Daten aus einem ExcelSheet ( qryDaten)  mit folgenden Einträgen:

Zeile: 2 D:\03 - Netzwerk\Programmierung für Technik\H7517375112634.jpg
Zeille 3: D:\03 - Netzwerk\Programmierung für Technik\H7517384032134.jpg

nach dem 1. Durchlauf wird Zeile 2:2 gelöscht - und Zeile 3 rückt nach oben  u.s.w. - wie gesagt mit Bestätigen :

Kein Problem !  Lösung mit direkt einfügen wäre perfekt !

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)

Hallo,

wenn du die Bilder aus einer Liste einfügen willst, dann brauchst du keinen Filedialog. Der wird ja nur gebraucht, wenn du die Bilder, die eingefügt werden sollen auswählen willst.

Das folgende Makro fügt alle Bilder, die in der Tabelle qryDaten in Spalte A stehen in die Tabelle Blanco in Spalte G ein. Die Bilder werden ab der 1. Zeile und dann 10 Zeilen tiefer eingefügt:

Sub bilder_einfuegen()

Dim arrBilder As Variant
Dim b As Long

'Bilder aus Tabelle qryDaten auslesen
'Pfad mit Bild und Endung steht in Spalte A ab Zeile 2
With Worksheets("qryDaten")
  arrBilder = .Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1))
End With

'Bilder in Tabelle Blanco einfügen
With Worksheets("Blanco")
  For b = LBound(arrBilder) To UBound(arrBilder)
     'Bild wird in Spalte G der Einfügezeile in Breite 160 und Höhe 120 eingefügt
     'ab Zeile 1 in jede 10. Zeile
     .Shapes.AddPicture arrBilder(b, 1), msoFalse, msoTrue, Cells(1 + 10 * (b - 1), 7).Left, Cells(1 + 10 * (b - 1), 7).Top, 160, 120
  Next b
End With

End Sub


Gruß

M.O.

0 Punkte
Beantwortet von

Hallo Vielen Dank .. es funktioniert - ist aber für meinen Bedarf nicht praktisch.

Weil ich habe eine Reihe von Macro-Abfolgen:

im Sheet gryDaten stehen in Zeile2 ab Spalte A bis K diverse Daten die per Macro in eine Schablone im Sheet Blanco eingelesen werden. In Spalte L2 steht dann der Pfad mit Bild und Endung ! Dies muss dann in Blanco auf G11 eingefügt werden ( Formatierung wie in Deinem Beispiel anwendbar !) - dann wird die gesamte Schablone mit  Inhalt in eine andere Excel-Datei per VBA überführt ( wird immer an der nächst freien Zelle eingefügt.). In gryDaten werden dann Zeile 2:2 gelöscht   die Zeile 3:3 rückt hoch - und das gleiche Prozedere beginnt von vorn - ( die Schablone wird zuvor mit allen Daten und Bild wieder " entleert " ).

Dies ist mir mit Deiner Function in dieser Form nicht gelungen !

Noch eine Idee ?   Ansosnten lassen ich meine bisherige Applikation mit dem FileDialog !

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)

Hallo,

wenn ich das richtig verstehe, dann muss ja eigentlich nur das Bild, dessen Pfad gerade in der Tabelle qryDaten in der Zelle L2 steht in die Tabelle Blanco in Zelle G11 eingefügt werden. Dafür brauchst du natürlich keine Schleife (das war aber aus deiner Frage und deiner 1. Antwort nicht zu erkennen). Das kannst vielmehr in der Schleife machen, mit der du die Tabelle Blanco füllst:

With Worksheets("Blanco")
  'Bild einfügen
     .Shapes.AddPicture ThisWorkbook.Worksheets("qryDaten").Range("L2"), msoFalse, msoTrue, .Range("G11").Left, .Range("G11").Top, 160, 120
End With

Gruß

M.O.

0 Punkte
Beantwortet von
Super ! Jetzt funktioniert es tadellos ! Eigentlich warum immer nur die komplizierten Sachen suchen - wenn das Einfache buchstäblich " auf der Strasse liegt " ? . Tut mit leid - irgndwie war ich blockiert - ich benötigte einfach nur den s.g. " Klaps " !  Ich hatte von Anfang an natürlich nicht erwähnt dass, die Daten per Schleife schon eingesetzt werden - nur noch das jpg fehlt - Du hast dies genau erkannt !

Nochmals vielen Dank und schöne Ostern !
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo,

freut mich, dass jetzt alles wie gewünscht funktioniert. Auch ich wünsche dir schöne Ostern.

Gruß

M.O.
...