Dies ist eine alte Version des Dokuments!

Bildnummerierung

Wenn man mehrere Bilder gleich benennen und mit einer fortlaufenden Nummer versehen will, eignet sich dazu hervorragend die Stapelverarbeitung von FixFoto.
Soll dies innerhalb einer Bearbeitung mehrerer Bilder per Skript erfolgen, wird hier beispielhaft gezeigt, wie diese Aufgabe per Skript gelöst werden kann.

Es wird ein Bildername "NameNeu" festgelegt und der Ordner "Zielordner" abgefragt, in dem die nummerierten Bilder gespeichert werden sollen. Da in diesem Ordner bereits nummerierte Bilder mit dem neuen Namen abgelegt sein können, wird ermittelt, welche höchste Nummer dort existiert. Diese höchste Nummer, sie kann auch 0 sein, wird bei der danach folgende Benennung und Nummerierung berücksichtigt.

Option Explicit

const NameNeu = "Muster" 'neuen Bildnamen festlegen Dim Abbruch : Abbruch = false

Dim fso : Set fso = CreateObject("Scripting.FileSystemObject") Dim Bilder,Zielordner,k

call main if not Abbruch then

  k = Bild_Max(Zielordner,NameNeu & "_")                  'Korrekturwert für die Bildnummer
  call B_Nummerierung                                     'Bildnummerierung

end if

Set fso = Nothing '——————————————————————————————————- sub main

Bilder = FF_GetSelection(1) '0 = alle Dateien der Computeransicht

                                                 '1 = alle selektierten Dateien der Computeransicht
                                                 '2 = alle Dateien der aktuellen Bilderliste
                                                 '3 = alle selektierten Dateien der aktuellen Bilderliste

if len(Bilder) = 0 then

  msgbox "Es wurden keine Bilder ausgewählt!",vbInformation,"Abbruch"
  Abbruch = true
  exit sub

end if

do 'Zielordner abfragen

  FF_SetCurrentPath FF_GetImagePath
  Zielordner = FF_EnterPath(false,"Ordner auswählen!")
  if Zielordner <> "" then exit do

loop

end sub '——————————————————————————————————- Function Bild_Max(OrdnerAngabe,FilterAngabe) 'maximale Bildnummer ermitteln Dim f,f1,fc,MBild,pos

Set f = fso.GetFolder(OrdnerAngabe) Set fc = f.Files

For Each f1 in fc

  if instr(f1.Name,FilterAngabe) = 1 then
      if f1.Name > MBild then MBild = f1.Name
  end if

      Bild_Max = 0

else

  pos = InStrRev(MBild,"_")
  if pos > 0 then    Bild_Max = mid(MBild,pos+1,4) else Bild_Max = 0
  if IsNumeric(Bild_Max) then Bild_Max = Bild_Max *1 else k = 0

end if

Set f = nothing Set fc = nothing

End Function '——————————————————————————————————- sub B_Nummerierung 'ausgewählte Bilder nummerieren Dim Array,b,extension,suffix

Array = split(Bilder, vbNewLine)

for b = 0 to ubound(Array) 'Bilder mit neuem Namen und fortlaufender

  FF_LoadImage(Array(b))                        '    Nummerierung abspeichern
  extension = "." & fso.GetExtensionName(Array(b))

  suffix = b +1 +k
  do while len(suffix) < 4 : suffix = "0" & suffix : loop            'len(suffix) < 4, wenn Nummerierung 4-stellig

  FF_SaveImage Zielordner & "\" & NameNeu & "_" & suffix & extension,0