Makro ändern?

05/12/2011 - 09:11 von Peter Schuerer | Report spam
Hallo Zusammen,

XL2002/XP.
Ich soll ca. 110 Fotos (mit je ca. 2Mb) in XL ab A2 so einfügen, das in
Spalte B zu jedem Foto eine Beschreibung (eigener Text) eingefügt werden
kann. Pro DIN A4 Seite sollten mindestens 5 Fotos dargestellt werden.
Das folgende Makro habe ich im Internet gefunden ;-)

Wie kann ich folgendes Makro àndern das man:

1. Den Pfad auswàhlen kann, in dem die Fotos vorhanden sind?
2. Das die Fotos ab A2 eingefügt werden?

Sub Bilder()
Dim NameZiel As Variant, Nr As Integer, shpRectangle As Shape
ChDir "D:\Test\Test2\Bilder Test\" 'Pfadvorgeben

NameZiel = Application.GetOpenFilename("Jpg (*.jpg),*.jpg," & _
"Png -Bilder (*.png),*.png," & _
"BMP (*.bmp),*.bmp", , "Bild-Dateien für Dokumentation auswàhlen!",
MultiSelect:=True)

If TypeName(NameZiel) = "Boolean" Then
Beep
MsgBox "Sie müssen min. eine Datei auswàhlen!"
Exit Sub
End If
'sortierroutine
For i = LBound(NameZiel) To UBound(NameZiel)
For J = (i + 1) To UBound(NameZiel)
If NameZiel(i) > NameZiel(J) Then
Rem MsgBox Nums(i)
tmp = NameZiel(i)
NameZiel(i) = NameZiel(J)
NameZiel(J) = tmp
End If
Next J
Next i
'einfüge Bilder in Zellen
For Nr = LBound(NameZiel) To UBound(NameZiel)
'MsgBox "ausgewàhlte Dateien" & (NameZiel(Nr))
'ab hier, da war ich rüben klauen :-)
With Range(Cells(Nr, 1), Cells(Nr, 3))
Set shpRectangle = ActiveSheet.Shapes.AddShape( _
msoShapeRectangle, .Left, .Top, .Width, .Height)
End With
shpRectangle.OLEFormat.Object.ShapeRange.Fill.UserPicture
NameZiel(Nr)
Next Nr
End Sub

Danke und Gruß
Peter
 

Lesen sie die antworten

#1 Bernhard Sander
05/12/2011 - 15:17 | Warnen spam
Hallo Peter,

XL2002/XP.
Ich soll ca. 110 Fotos (mit je ca. 2Mb) in XL ab A2 so einfügen, das in Spalte B
zu jedem Foto eine Beschreibung (eigener Text) eingefügt werden kann. Pro DIN A4
Seite sollten mindestens 5 Fotos dargestellt werden.
Das folgende Makro habe ich im Internet gefunden ;-)

Wie kann ich folgendes Makro àndern das man:

1. Den Pfad auswàhlen kann, in dem die Fotos vorhanden sind?
2. Das die Fotos ab A2 eingefügt werden?


Sub Bilder()
Dim NameZiel As Variant, Nr As Integer, shpRectangle As Shape
ChDir "D:\Test\Test2\Bilder Test\" 'Pfadvorgeben

NameZiel = Application.GetOpenFilename("Jpg (*.jpg),*.jpg," & _
"Png -Bilder (*.png),*.png," & _
"BMP (*.bmp),*.bmp", , "Bild-Dateien für Dokumentation auswàhlen!",
MultiSelect:=True)



Sinnvollerweise solltest Du die Zeile ChDir ... weglassen oder dort Deinen
gewünschten Startpfad angeben. GetOpenFilename startet dann in diesem Ordner.

GetOpenFilename bietet bereits die Möglichkeit, einen anderen Ordner zu wàhlen.
Reicht Dir das nicht?
Ich fànde es nun nicht sehr sinnig, wenn zuerst ein Dialog zur Auswahl des
Ordners erscheint und danach der "Datei Öffnen"-Dialog, in dem man nochmal den
Ordner auswàhlen kann. Aber wer weiß!


'einfüge Bilder in Zellen
For Nr = LBound(NameZiel) To UBound(NameZiel)
'MsgBox "ausgewàhlte Dateien" & (NameZiel(Nr))



Die Parameter von Cells stehen für 1. Zeile, 2. Spalte. Hier werden die Bilder
also in den Spalten A-C abgelegt. Nr làuft von 1 bis zur Anzahl der gewàhlten
Bilder. Du musst also dafür sorgen, das die Zeilennummer entsprechend höher
gewàhlt wird. Du willst ab A2 einfügen, und Du willst in Spalte B was daneben
schreiben.
àndere daher diese Zeile:

With Range(Cells(Nr, 1), Cells(Nr, 3))



in folgende 2 Zeilen ab:

Zielzeile = Nr + 1
With Range(Cells(Zielzeile, 1), Cells(Zielzeile, 1))

Ich habe nicht ausprobiert, mit welcher Indexnummer das Array NameZiel beginnt
[LBound(NameZiel)]. Ich gehe mal davon aus, dass es mit 1 anfàngt. Falls es mit
0 anfàngt, muss die Variable Zielzeile = Nr + 2 werden.

Komme nicht auf die Idee, einfach 1 (oder 2) zu Nr dazuzuaddieren, sonst setzt
die letzte Zeile in der Schleife [shpRectangel NameZiel(Nr)] das falsche
Bild ein.


Die Bilder so auszurichten, dass jeweils 5 auf eine A4-Seite passen ist nochmal
eine Aufgabe für sich.

Gruß
Bernhard Sander

Ähnliche fragen