3.1k 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 syler902 Mitglied (159 Punkte)
Okay also das sieht schon sehr viel besser aus :-)
Also wenn es noch geht das man den Abstand von einer Zelle zwischen den Bilder von oben nach unten gesehen noch weg nimmt dann glaube ich
müsste es auch passen das die unteren beiden bilder nicht abgeschnitten werden. Wenn du das noch hin bekommen würdest dann wäre mein Problem
gelöst :D
0 Punkte
Beantwortet von syler902 Mitglied (159 Punkte)
Also wenn die Abstände nämlich nicht sind dann würde es genau passen
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo Julian,

lasse mir doch mal die Datei mit den Bildern zukommen, bei der die letzten beiden nicht passen. Ich werde mir das dann mal anschauen.

Gruß

M.O.
0 Punkte
Beantwortet von syler902 Mitglied (159 Punkte)
Email ist unterwegs ;-)
0 Punkte
Beantwortet von syler902 Mitglied (159 Punkte)
So die Email ging an die falsche Person.  Habe dir eine private Nachricht gesendet. Dann kannst mir deine Mail Adresse einmal senden dann schicke ich dir die Excel
Tabelle für die kleine Änderung
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Hallo Julian,

ich habe deine E-Mail erhalten :-).

Ändere mal die Zeile
[code]lngZeile = lngZeile + 13[/code]
in
[code]lngZeile = lngZeile + 12[/code]
und lasse den Code dann noch einmal laufen.

Gruß

M.O.
0 Punkte
Beantwortet von syler902 Mitglied (159 Punkte)
Vielen vielen Dank jetzt klappt es :d sehr cool danke dir :-)
0 Punkte
Beantwortet von syler902 Mitglied (159 Punkte)
Soo ich habe noch mal ein wenig selber probiert und mir die Maße sogar selber eingestellt bekommen ( keine Ahnung wie es funktioniert hat aber
egal^^ ).
Was jetzt echt noch genial wäre. wenn ich zu den bildern jeweils noch einen standard text einfügen könnte. In der 1. spalte neben bild rechts
- Lego Star Wars , Fett und unterstrichen  Schriftgröße 14
- Name: Fett mit Unterstrich 12                 
-( Leere Zeile) 12
- Farben: Fett mit Unterstrich12             
-( Leere Zeile)12
-( Leere Zeile )12
-Preis ca.: fett mit unterstrich12
-( Leere Zeile)12
Set Nr.: fett mit unterstrich
-( Leere Zeile)



Den geschriebenen Text von M.O. Habe ich so verändert :

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 17,75 festlegen
With ActiveSheet
 Set rngSpalte = .Range("A:A,C:C,E:E,G:G,I:I,K:K")
  rngSpalte.ColumnWidth = 17.75
 '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 + 12      '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, 110, 140
      End With
               
     End If
               
      DateiName = Dir
    Loop

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

End Sub






wäre cool wenn sich einer da noch mal die Zeit nimmt wenn nicht sogar der M.O.   ;-)
...