467 Aufrufe
Gefragt in Datenbanken von syler902 Mitglied (159 Punkte)
Hallo.
So ich habe folgendes Problem bzw folgende Aufgabe vor mir.
Ich möchte einen Katalog für mich selbst erstellen in dem Lego Minifiguren aufgeführt
sind.
Pro Seite sollen es 8 Figuren sein, 2 neben einander und 4 untereinander.
Bislang habe ich wirklich jedes einzelne Zeile angeklickt und bin dann über einfügen -
Bilder und naja habe jedes einzelne bild einzeln in die Excel Tabelle geklickt. Da ich aber
noch ca 4-5000 Bilder vor mir habe, brauche ich iwie eine schneller Variante.
Ich hoffe Ihr könnt mir hierbei helfen.

18 Antworten

0 Punkte
Beantwortet von m-o Profi (15.8k Punkte)
Hallo,

das könnte man wohl über ein Makro lösen. Dazu bräuchte man aber noch ein paar Informationen:
Liegen die Bilder alle im selben Verzeichnis?
In welcher Größe sollen die Bilder eingefügt werden?
[quote]Pro Seite sollen es 8 Figuren sein, 2 neben einander und 4 untereinander.[/quote]
Stelle doch mal dar, in welche Zellen du die Bilder der ersten beiden Seiten eingefügt hast.

Gruß

M.O.
0 Punkte
Beantwortet von syler902 Mitglied (159 Punkte)
Also das mit Verzeichnis. Es ist ein Ordner auf dem Desktop in dem sind
mehrere Ordner mit zig unterordnern. Habe aber verschiedene Themen
welche halt in verscheidenen Ordnern abgelegt sind. zu den Maßen. Ich
bastel die Seite eben noch mal durch und. Hast du vllt ne email adresse
wo ich dir ein bilder davon schicken kann oder einfach die excel tabelle
das du dir das einmal angucken kannst ?
0 Punkte
Beantwortet von m-o Profi (15.8k Punkte)
Hallo Julian,

ich habe dir eine persönliche Nachricht mit einer E-Mail-Adresse zukommen lassen.

Du kannst die Excel-Datei (mit max. 16 Bildern) aber auch auf einen Hoster deiner Wahl (z.B. [url=http://www.filehorst.de/]hier[/url]) hochladen und den Link dann im Forum posten.

Sollen die Bilder aus den verschiedenen Unterordnern in jeweils verschiedene Arbeitsblätter der Datei einfgefügt werden?

Gruß

M.O.
0 Punkte
Beantwortet von m-o Profi (15.8k Punkte)
Hallo Julian,

das folgende Makro gehört in ein [url=http://www.excelbeispiele.de/Modul.htm]Modul[/url] der Arbeitsmappe(n).
Das Makro formatiert die Seite so, dass jeweils 4 x 2 Bilder auf eine Seite passen. Auch die Spaltenbreiten werden entsprechend angepasst.
Ist das Makro gestartet wird zuerst die Seite eingerichtet. Dann wirst du aufgefordert, einen Pfad für den Import der Bilder auszuwählen. Es werden nur jpg-Dateien eingelesen. Ggfs. musst die Endung im Makro ändern. Es werden keine Unterverzeichnisse eingelesen.
[code]Sub Bilder_einlesen()

Dim strPfad As String
Dim DateiName As String
Dim lngZaehler As Long
Dim lngSpalte As Long
Dim lngZeile As Long

With Application
        .ScreenUpdating = False                   'Bildschirmaktualisierung ausschalten
        .EnableEvents = False                     'Ereignisse ausschalten
        .Calculation = xlCalculationManual        'automatische Berechnuns ausschalten
End With

'erste Zeile und Spalte zum Einfügen festlegen
lngZeile = 1
lngSpalte = 1

'Tabelle einrichten
'Spalten A und C (für Bilder) Breite von 22,29 festlegen
With ActiveSheet
  .Columns("A:A").ColumnWidth = 22.29
  .Columns("C:C").ColumnWidth = 22.29
'Spalten B und D (für Erläuterungen) Breite von 20 festlegen
  .Columns("B:B").ColumnWidth = 20
  .Columns("D:D").ColumnWidth = 20
'Seitenränder (jeweils 1,5 cm) einrichten
 With .PageSetup
    .LeftMargin = Application.InchesToPoints(0.590551181102362)     'linker Seitenrand
    .RightMargin = Application.InchesToPoints(0.590551181102362)    'rechter Seitenrand
    .TopMargin = Application.InchesToPoints(0.590551181102362)      'oberer Seitenrand
    .BottomMargin = Application.InchesToPoints(0.590551181102362)   'unterer Seitenrand
 End With

End With

'Pfad auswählen und in Variable für Pfad schreiben
With Application.FileDialog(msoFileDialogFolderPicker)
     
        .AllowMultiSelect = False
        .Title = "Bitte Ordner wählen"
        .InitialFileName = ""
        .InitialView = msoFileDialogViewThumbnail
        .ButtonName = "OK"
            
        If .Show = -1 Then
          strPfad = .SelectedItems(1) & "\"
         Else
           MsgBox "Kein Pfad gewählt! Abbruch!", 16, "Abbruch!"  'Abbrechen wenn kein Pfad ausgewählt wurde
           Exit Sub
         End If
 
End With

    'nur Dateien mit Endung .jpg öffnen - Endung ggf. anpassen!
    DateiName = Dir(strPfad & "*.jpg")
    Do While DateiName <> ""
      lngZaehler = lngZaehler + 1       'Zähler
      'Zeile und Spalte für das einzufügende Bild festlegen
      If lngZaehler > 1 Then
        If lngZaehler Mod 2 = 1 Then     'ist Zähler ungrade
          lngZeile = lngZeile + 13       'dann neue Zeile festlegen
        Else
          If lngZaehler > 1 Then         'ansonsten Einfügespalte neu festlegen
            If lngSpalte = 1 Then
              lngSpalte = 3              'Spalte C
            Else                         'oder
              lngSpalte = 1              'Spalte A
            End If
          End If
        End If
       End If
       
      'Bilder einfügen
      'Bild in Zellen einfügen, 4,3 cm breit - 1 cm =  = 28,35 pt ergibt 121,91 pt - und 6,64 cm hoch = 188,24

      With ActiveSheet
        .Shapes.AddPicture strPfad & DateiName, msoFalse, msoTrue, .Cells(lngZeile, lngSpalte).Left, .Cells(lngZeile, lngSpalte).Top + 1, 122, 188
      End With
               
      DateiName = Dir
    Loop

 With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With

End Sub
[/code]
Gruß
M.O.
0 Punkte
Beantwortet von syler902 Mitglied (159 Punkte)
okay also muss ich den Text dann quasi nur kopieren? und dann einfügen. Und was genau brauche ich bzw muss ichim text ändern wenn es jpg und
png datein sind die im Ordner vorhanden sind ?
0 Punkte
Beantwortet von syler902 Mitglied (159 Punkte)
OKay Danke hat halbwegs funktioniert.
Problem ist  jetzt noch das die Bilder eingefügt werden aber die letzten beiden bilder unten über das Maß der DinA4 Seite hinnaus gehen, somit
werden die Beine abgeschnitten.
Und was ich für die Übersicht bräuchte, ich weiß kommt vllt etwas spät, aber es wäre super wenn die Bilder quasi nicht auf der linken seite verteilt
werden sondern quasi auch nach rechts. sorich 6 bilder nebeneinander ; sozusagen 3 DinA4 Seiten nebeneinander wenn man auf den excel desktop
schaut. Hoffe das war nicht zu kompliziert erklärt. Also quasi 6 nebeneinander , aber so das immer nur 2 nebeneinander auf einer angezeigten ( mit
seitenlayout auf a4 ) DINA4 Seite sitzen.
0 Punkte
Beantwortet von syler902 Mitglied (159 Punkte)
Und was mir halt fehlt ist das ich neben jedem Bild rechts einen Kleinen Text hinschreiben muss. Sprich die Bilder auf der rechten Seite müssten mehr
in richtung mitte damit ich auf der rechten seite neben den rechten bilder noch ein wenig platz habe um etwas zu schreiben.
0 Punkte
Beantwortet von syler902 Mitglied (159 Punkte)
Also würde mir schon reichen wenn er JPG erkennt und PNG Zusammen und mir dann 6 nebeneinander packt. den rest kann ich mir dann auch hin
ziehen das geht ja recht einfach und schnell
0 Punkte
Beantwortet von m-o Profi (15.8k Punkte)
Hallo Julian,

ich habe mich bei der Erstellung deines Makros an deiner Beispieldatei orientiert und das mit ein paar Bildern getestet (natürlich nicht mit mehreren hundert oder gar tausend Bildern). Da hat alles mit der Seitenaufteilung gepasst; das hängt aber teilweise auch mit dem verwendeten Drucker zusammen. Wenn es aber nur die letzten Bilder sind und alles andere passt, kann man das ja auch mit der Hand anpassen.

Ich habe das Makro jetzt so umgebaut, dass jeweils 6 Bilder nebeneinander eingefügt werden. Ich habe die Bilder etwas schmaler gemacht. Schau mal ob der Platz reicht. Ansonsten kannst du ja mal mit der Breite (jetzt 120) und Höhe (jetzt 186) experimentieren. Es werden Bilder mit den Endungen jpg und png eingelesen.
[code]Sub Bilder_einlesen()

Dim strPfad As String
Dim DateiName As String
Dim lngZaehler As Long
Dim lngSpalte As Long
Dim lngZeile As Long
Dim rngSpalte As Range

With Application
        .ScreenUpdating = False                   'Bildschirmaktualisierung ausschalten
        .EnableEvents = False                     'Ereignisse ausschalten
        .Calculation = xlCalculationManual        'automatische Berechnuns ausschalten
End With

'erste Zeile und Spalte zum Einfügen festlegen
lngZeile = 1
lngSpalte = 1

'Tabelle einrichten
'Spalten für Bilder Breite von 22,29 festlegen
With ActiveSheet
 Set rngSpalte = .Range("A:A,C:C,E:E,G:G,I:I,K:K")
  rngSpalte.ColumnWidth = 22.29
 'Spalten für Erläuterungen Breite von 20 festlegen
  Set rngSpalte = .Range("B:B,D:D,F:F,H:H,J:J,L:L")
  rngSpalte.ColumnWidth = 20
  'Seitenränder (jeweils 1,5 cm) einrichten
 With .PageSetup
    .LeftMargin = Application.InchesToPoints(0.590551181102362)     'linker Seitenrand
    .RightMargin = Application.InchesToPoints(0.590551181102362)    'rechter Seitenrand
    .TopMargin = Application.InchesToPoints(0.590551181102362)      'oberer Seitenrand
    .BottomMargin = Application.InchesToPoints(0.590551181102362)   'unterer Seitenrand
 End With

End With

'Pfad auswählen und in Variable für Pfad schreiben
With Application.FileDialog(msoFileDialogFolderPicker)
     
        .AllowMultiSelect = False
        .Title = "Bitte Ordner wählen"
        .InitialFileName = ""
        .InitialView = msoFileDialogViewThumbnail
        .ButtonName = "OK"
            
        If .Show = -1 Then
          strPfad = .SelectedItems(1) & "\"
         Else
           MsgBox "Kein Pfad gewählt! Abbruch!", 16, "Abbruch!"  'Abbrechen wenn kein Pfad ausgewählt wurde
           Exit Sub
         End If
 
End With

    'nur Dateien mit Endung jpg und png öffnen
    DateiName = Dir(strPfad)
    Do While DateiName <> ""
     If LCase(Right(DateiName, 3)) = "jpg" Or LCase(Right(DateiName, 3)) = "png" Then
      
      lngZaehler = lngZaehler + 1       'Zähler für Bilder
      'Zeile und Spalte für das einzufügende Bild festlegen
      If lngZaehler > 1 Then
        If lngZaehler Mod 6 = 1 Then     'ist Zähler ungrade
          lngZeile = lngZeile + 13       'dann neue Zeile festlegen
        Else
          If lngZaehler > 1 Then         'ansonsten Einfügespalte neu festlegen
           lngSpalte = lngSpalte + 2
           If lngSpalte > 11 Then lngSpalte = 1
          End If
       End If
     End If
       
      'Bilder einfügen
      'Bild in Zellen einfügen, 4,3 cm breit - 1 cm =  = 28,35 pt ergibt 121,91 pt - und 6,64 cm hoch = 188,24

      With ActiveSheet
        .Shapes.AddPicture strPfad & DateiName, msoFalse, msoTrue, .Cells(lngZeile, lngSpalte).Left, .Cells(lngZeile, lngSpalte).Top + 1, 120, 186
      End With
               
     End If
               
      DateiName = Dir
    Loop

 With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With

End Sub[/code]
Gruß

M.O.
0 Punkte
Beantwortet von syler902 Mitglied (159 Punkte)
Alles Klar vielen Dank ich probiere es gleich mal aus und sage dir Bescheid :-)
...