Ordner FileList Sortieren
02.02.2017 11:57:45
Wolfgang
ich habe schon viel zum Thema File Sortierung in VBA gelesen´, bekomme es aber einfach nicht für mein Skript umgesetzt.
Mein Skript ist eigentlich simpel. Es fügt alle Bilder aus Order A in die Präsentation und fügt danach alle BIlder aus Order B auf die gleichen Seiten.
Das Problem ist, das ich die Files nicht Sortiert bekomme und daher die Bildzuordnung von A&B nicht passt.
Hier mein Code:
Sub BildVergleich()
' Einfügen Variante A
Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner der Variante A auswählen", &H1000, 17)
If BrowseDir Is Nothing Then
Exit Sub
Else
Pfad = BrowseDir.Items().Item().Path
'If Pfad = Leer Then Exit Sub
End If
' Position in Folie
x = 0.44 * 72 / 2.54
y = 9.37 * 72 / 2.54
' Bild Skalieren
NewW = 16.47 * 72 / 2.54
NewH = 8.83 * 72 / 2.54
'StartFolie
Foliennummer = 4
Dim fs As Object
Dim fVerz As Object
Dim fDatei As Object
Dim fdateien As Object
Dim strDat As String
Set fs = CreateObject("scripting.FileSystemObject")
Set fVerz = fs.getFolder(Pfad)
Set fdateien = fVerz.Files
ipage = 4
For Each fDatei In fdateien
strDat = fDatei.Name
PfadDatei = Pfad & "\" & strDat
ActivePresentation.Slides(ipage - 1).Duplicate 'Folie 3 duplizieren
ActivePresentation.Slides(ipage).Select 'Folie "iPage auswählen
ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:=PfadDatei, LinkToFile:= _
msoFalse, SaveWithDocument:=msoTrue, Left:=Round(x), Top:=Round(y), Width:=NewW, Height:=NewH). _
_
Select
Next fDatei
' Einfügen Variante B
Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner der Variante B auswählen", &H1000, 17)
If BrowseDir Is Nothing Then
Exit Sub
Else
Pfad = BrowseDir.Items().Item().Path
'If Pfad = Leer Then Exit Sub
End If
' Position in Folie
x = 17.27 * 72 / 2.54
y = 9.37 * 72 / 2.54
' Bild Skalieren
NewW = 16.47 * 72 / 2.54
NewH = 8.83 * 72 / 2.54
'StartFolie
Foliennummer = 4
Set fs = CreateObject("scripting.FileSystemObject")
Set fVerz = fs.getFolder(Pfad)
Set fdateien = fVerz.Files
ipage = 4
For Each fDatei In fdateien
strDat = fDatei.Name
PfadDatei = Pfad & "\" & strDat
' ActivePresentation.Slides(iPage - 1).Duplicate 'Folie 3 duplizieren
ActivePresentation.Slides(ipage).Select 'Folie "iPage auswählen
ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:=PfadDatei, LinkToFile:= _
msoFalse, SaveWithDocument:=msoTrue, Left:=Round(x), Top:=Round(y), Width:=NewW, Height:=NewH). _
_
Select
ipage = ipage + 1
Next fDatei
End Sub
Ich hoffe ihr könnt mir helfen.
Gruß
Wolfgang