Bilderinfo nach Excel

Allgemein Dateiinfos nach Excel übertragen 4.12

Mecki14

Mitglied
Dabei seit
15.03.06
Beiträge
2.810
Standort
Düsseldorf
Trophäen
einige {*} {!} * !
#1
Angeregt durch das Skript Dir_in_DOC habe ich ein VB-Skript Dir_in_XLS geschrieben:

Code:
' *********************************************************************
' Funktion:      Schreibt ein Dateininhaltsverzeichnis des gedroppten
'                bzw. ausgewähltene Ordners in eine neue Excel-Tabelle
'
' Erfordert:    - Windows Scripting Host 2.0
'               - Excel ab Version 97
'
' Vorgehen:	- Datei auf dem Desktop ablegen oder 
'		  dort eine Verknüpfung erstellen
'
' Anwendung	- Anzuzeigenden Ordner auf die Datei bzw.
'		  auf die Verknüpfung ziehen oder
'		- nach Doppelklick anzuzeigenden Ordner
'		  auswählen und mit OK bestätigen
' 
' Copyright (C) 2006 Harald Maeckler, Düsseldorf
' *********************************************************************

Option Explicit

'Definitionen
Dim AppShell
Dim BrowseDir
Dim Verz

Dim objFS	 'FileSystemObject
Dim objFolder	 'Ordner
Dim objSubFolder 'Unterordner
Dim objFile	 'Dateien
Dim FileAnzahl	 'Dateizähler
Dim SubFolderG	 'Unterordnergröße
Dim objExcel	 'Excel
Dim Zeile	 'Zeile
Dim strExt	 'Extension einer Datei

'Excel-Konstante
Const xlRight = 4	'Rechtsbündig
Const xlCenter = 3	'Mittig

'******************* VB-Script **************************************

On Error Resume Next


Set objFS = WScript.CreateObject("Scripting.FileSystemObject")			'FileSytemObject

Set objFolder = objFS.GetFolder(WScript.Arguments(0))				'gedroppter Ordner
	If objFolder Is Nothing Then

		Set AppShell = CreateObject("Shell.Application")		'Explorer-Aufruf
		Set BrowseDir = AppShell.BrowseForFolder(0, "", &H1, 17)
		Verz = BrowseDir.ParentFolder.ParseName(BrowseDir.Title).Path

		If Err.Number > 0 Then
			Pos = InStr(BrowseDir, ":")
			Verz = Mid(BrowseDir, Pos - 1, 1) & ":\"
		End If

		Set objFolder =  objFS.GetFolder(Verz)


	End If

	If objFolder Is Nothing Then						'kein Ordner bekannt 
		MsgBox "Kein Ordner ausgewählt", vbInformation, Wscript.ScriptName
		WScript.Quit
	End if

Set objExcel = WScript.CreateObject("Excel.Application")			'Excel-Aufruf
	If objExcel Is Nothing then
	    MsgBox "Excel kann nicht gestartet werden.", vbInformation, Wscript.ScriptName
	    WScript.Quit
	End If

With objExcel
.Workbooks.Add
.Visible = True

.ActiveSheet.Cells(1,1).Value = "Inhalt von " & objFolder.Path			'Ordneranzeige

	Zeile = 3

Dim UVv
Dim objNFolder	'#### weitere Unter-Unterordner vorhanden -> <+ UV>

        For Each objSubFolder In objFolder.SubFolders				'Unterordner-Auflistung
            	.ActiveSheet.Cells(Zeile,2).Value = objSubFolder.Files.Count & " Dateien"
            	.ActiveSheet.Cells(Zeile,4).Value = UCase(objSubFolder.Name)
			Set objNFolder = objFS.GetFolder(objSubFolder.Path)
			if objNFolder.SubFolders.Count > 0 then
				.ActiveSheet.Cells(Zeile,5).Value = "+ <Verz>"
				UVv = True
			else
            			.ActiveSheet.Cells(Zeile,5).Value = "<Verz>"            
			end if
            	.ActiveSheet.Cells(Zeile,6).Value = objSubFolder.Size
            	.ActiveSheet.Cells(Zeile,7).Value = "Bytes"  
            	.ActiveSheet.Cells(Zeile,9).Value = objSubFolder.DateLastModified
	    Zeile = Zeile + 1
	    FileAnzahl = FileAnzahl + objSubFolder.Files.Count			'Dateienanzahl Unterordner
	    SubFolderG = SubFolderG + objSubfolder.Size				'Größensumme Unterordner
        Next

	if FileAnzahl > 0 then Zeile = Zeile + 1

	.ActiveSheet.Cells(Zeile,2).Value = objFolder.Files.Count & " Dateien"
	.ActiveSheet.Cells(Zeile,4).Value = "direkt im Hauptverzeichnis"
		.Range("D" + Cstr(Zeile)).Select
		.Selection.Font.FontStyle = "Kursiv"				'Schrift Kursiv
	.ActiveSheet.Cells(Zeile,6).Value = objFolder.Size - SubFolderG	 	'Größensumme H.-Verz.
	.ActiveSheet.Cells(Zeile,7).Value = "Bytes"
	.ActiveSheet.Cells(Zeile,9).Value = objFolder.DateLastModified		'Datum des H.-Verz.

	Zeile = Zeile + 1
	
	FileAnzahl = FileAnzahl + objFolder.Files.Count				'Dateienanzahl gesamt

        For Each objFile In objFolder.Files					'Dateien-Auflistung
		.ActiveSheet.Cells(Zeile,4).Value = objFile.Name
	strExt = objFS.GetExtensionName(objFile.Name) 				'Datei-Extension ermitteln
		.ActiveSheet.Cells(Zeile,5).Value = UCase(strExt)
		.ActiveSheet.Cells(Zeile,6).Value = objFile.Size
            	.ActiveSheet.Cells(Zeile,7).Value = "Bytes"
		.ActiveSheet.Cells(Zeile,9).Value = objFile.DateLastModified
	    Zeile = Zeile + 1
        Next

	Zeile = Zeile + 1

	.ActiveSheet.Cells(Zeile,1).Value = "Zusammenfassung:"			'Zusammenfassung
		.Range("A" + Cstr(Zeile)).Select
		.Selection.Font.FontStyle = "Fett"				'Schrift Fett
	Zeile = Zeile + 1
	.ActiveSheet.Cells(Zeile,2).Value = FileAnzahl & " Dateien"
	.ActiveSheet.Cells(Zeile,6).Value = objFolder.Size
      	.ActiveSheet.Cells(Zeile,7).Value = "Bytes"

'Formatierung
    .Range("A1").Select	
    .Selection.Font.FontStyle = "Fett"		'Schrift Fett
    .Selection.ColumnWidth = 1			'Spaltenbreite 1 setzen
    .Range("C1").Select	
    .Selection.ColumnWidth = 1			'Spaltenbreite 1 setzen
    .Range("E1").Select
    .Selection.ColumnWidth = 5			'Spaltenbreite 5 setzen
    .Range("H1").Select    
    .Selection.ColumnWidth = 1			'Spaltenbreite 1 setzen
    .Columns("B:I").Select
    .Selection.Columns.AutoFit			'Optimierung der Spaltenbreite
    .Columns("F:F").Select
    .Selection.NumberFormat = "#,##0"		'Formatierung der Größen
    .Columns("B:B").Select
    .Selection.HorizontalAlignment = xlRight	'Rechtsbündige Anordnung
    .Columns("E:E").Select
    .Selection.HorizontalAlignment = xlRight	'Rechtsbündige Anordnung
    .Range("A1").Activate

End With

if UVv then MsgBox "'+ <Verz>' bedeutet, dass im Unterordner weitere Unterverzeichnisse vorhanden sind." _
& vbCr & "Die darin enthaltenen Dateien werden nicht mitgezählt, aber die Dateigrößen werden mit aufaddiert" _
,,"Hinweis"
'**************************************************************************************************************
Der Code muss in einen Texteditor kopiert und dann als VBS-Datei (z.B. Dir_in_XLS.vbs) abgespeichert werden. Dann sollte man eine Verknüpfung auf dem Desktop erzeugen.
Zieht man nun einen Ordner auf die Verknüpfung oder wählt nach Doppelklick einen Ordner aus, wird der Inhalt des Ordners in Excel angezeigt und kann abgespeichert werden.

Neue Version ab 31.07.2007 - siehe unten: Beitrag #19
 
Zuletzt bearbeitet:

ralfeberle

FF-Team
Mitarbeiter
Dabei seit
10.07.02
Beiträge
11.289
Trophäen
10*15!4{*}1{!}
#2
AW: Dateiinfos nach Excel übertragen

Hallo!

Vielen Dank. Super, Arbeit gespart, denn das stand auf meinem langfristigen Plan.

Gruß,

Ralf
 

Mecki14

Mitglied
Dabei seit
15.03.06
Beiträge
2.810
Standort
Düsseldorf
Trophäen
einige {*} {!} * !
#3
AW: Dateiinfos nach Excel übertragen

Da ich nun mal dabei war, habe ich das Skript noch umgeschrieben auf ein FF-Skript, das wie üblich integriert werden kann.

Code:
'FFSubmenu=Dokumentation
'FFName=Bilderinfo nach Excel

' ***********************************************************************
' ImageInfo_To_Excel.vbs (Script für FixFoto)
'
' Funktion:     Schreibt Dateinamen mit ausgewählten Zusatzinformationen
'                in eine neue Excel-Tabelle.
' 
' Version 1.06 vom 24.01.2007 (mit vorgeschaltetem Dialog mit Bildfilter)
' Copyright (C) Harald Maeckler, Düsseldorf
' ***********************************************************************

Option Explicit

' ************** Standardfilter für 'Alle Bilder' **********************
Const BildKenn = "BMP-JP2-JPG-PNG-TIF"    'erlaubte BildKennungen
'************************************************************************
Const debuging = False

Dim objFS             'FileSystemObject
Dim objFolder         'Ordner
Dim objExcel        'Excel-Objekt
Dim imagecount        'BildZähler
Dim objFile             'Dateien
Dim FileAnzahl         'Dateizähler
Dim    DatGross        'Summe der Dateigrößen
Dim AeDatum            'Änderungsdatum
Dim Zeile              'Zeile
Dim Spalte            'Spalte
Dim EndSpalte        'letzte Spalte
Dim strExt             'Extension einer Datei
Dim FileN            'Filename komplett
Dim ZusText            'Zusammenfassung
Dim InfoTe            'Info temporär eins
Dim InfoTz            'Info temporär zwei
Dim n                'Zählervariable
Dim Pos                'StringPosition
Dim Antwort            'Antwort
Dim Abbruch            'Abbruch
Dim BFilter            'Bildfilter

Dim Breite            'Breite in Pixel
Dim Hoehe            'Höhe in Pixel

'Exif-Konstanten
Const Kamera = "Model"                    'Kameraname (Exif)
Const AufnDatum    = "DateTimeOriginal"     'Aufnahmedatum (Exif)
Const Blende = "FNumber"                'Blende
Const Zeit = "ExposureTime"                'Belichtungszeit
Const Korrektur = "ExposureBiasValue"    'Belichtungskorrektur
Const Brennweite = "FocalLength"        'Brennweite (nicht KB)
Const BrennwKB = "FocalLengthIn35mmFilm"'Brennweite (KB)
Const ISO = "ISOSpeedRatings"            'Empfindlichkeit
Const Blitz = "Flash"                    'Blitz (codiert)

'Excel-Konstanten
Const xlRight = -4152    'Rechtsbündig
Const xlCenter = -4108    'Mittig
Const xlLeft = -4131    'Linksbündig

Const xlDiagonalDown = 5
Const xlNone = -4142
Const xlDiagonalUp = 6
Const xlEdgeLeft = 7
Const xlContinuous = 1
Const xlThin = 2
Const xlAutomatic = -4105
Const xlEdgeTop = 8
Const xlEdgeBottom = 9
Const xlEdgeRight = 10
Const xlInsideVertical = 11
Const xlInsideHorizontal = 12
Const xlPrintNoComments = -4142
Const xlPortrait = 1    'Hochformat
Const xlLandscape = 2    'Querformat
Const xlPaperA4 = 9
Const xlDownThenOver = 1

'******************* VB-Script **************************************
'********************************************************************

On Error Resume Next

Set objFS = CreateObject("Scripting.FileSystemObject")            'FileSytemObject
Set objFolder = objFS.GetFolder(FF_GetImagePath())                'aktiver Ordner

    If objFolder Is Nothing Then                                'kein Ordner bekannt 
        MsgBox "Kein Ordner ausgewählt"
    else

        Set objExcel = CreateObject("Excel.Application")        'Excel-Aufruf
    
        If objExcel Is Nothing then
            MsgBox "Excel kann nicht gestartet werden (evtl. nicht installiert)."
        else
        
'**  Dialogbehandlung ***********************************************
dim Taste
dim DokuWert,Formwert,SeitenWert,AllgWert,ExifWert,FilterWert
dim Doku(2),Form(1),Seit(3),Allg(2),Exif(7),AllgSp(2),ExifSp(7),Rand

call Dialogaufruf
DokuWert = FF_GetProfile("FF_Doku-Excel", "DokuWert")    'Registry lesen
call WertBestimmung
call WerteEintrag
call Auswerten

if not Abbruch then
    call RegistrySchreiben
    FF_CloseDialog("Dateien-Doku")
    
    if debuging then
        msgbox     "DokuWahl  = " & Doku(0) & "-" & Doku(1) & "-" & Doku(2) & vbCr & _
                   "BlattWahl = " & Form(0) & "-" & Form(1) & vbCr & _
                   "Ränd.Wahl = " & Seit(0) & "-" & Seit(1) & "-" & Seit(2) & "-" & Seit(3) & vbCr & _
                   "Allg.Wahl = " & Allg(0) & "-" & Allg(1) & "-" & Allg(2) & vbCr & _
                   "Exif-Wahl = " & Exif(0) & "-" & Exif(1) & "-" & Exif(2) & "-" & Exif(3) & "-" & _
                                     Exif(4) & "-" & Exif(5) & "-" & Exif(6) & "-" & Exif(7)
    end if
    '** Ende Dialogbehandlung ********************************************
    
                objExcel.Cells.Select
                objExcel.Selection.NumberFormat = "@"
                Call ExcelEintrag
                if not Abbruch then
                    objExcel.Visible = False
                    
                    if debuging then msgbox "EndSpalte = " & EndSpalte
                    objExcel.Range("B3:" & chr(63+EndSpalte) & Cstr(Zeile-2)).Select
                    Call ExcelGitter
                    objExcel.Range("B3").Select
                    if EndSpalte = 3 then Call ExcelGitter
                    
                    Call SeiteFormatieren
                    MsgBox "Die Dateinamen wurden mit einigen Zusatzdaten nach Excel übertragen!"
                    objExcel.Visible = True
                else
                    MsgBox "Die Dokumentation wurde abgebrochen!"
                end if
else
    MsgBox "Die Dokumentation wurde abgebrochen!"
end if
            End If
    
    End if

'*********************************************************************
Sub ExcelEintrag()
'*** welche Dateien werden dokumentiert
'ausgBld=Doku(0) / alleBld=Doku(1) / alleDat=Doku(2)

if Doku(0) = "1" then        'ausgewählte Bilder
    imagecount = FF_GetImageCount
    if debuging then msgbox "Bilderzahl " & imagecount
    if imagecount = 0 then
        Antwort = msgbox("Es wurde kein(e) Bild(er) ausgewählt." & vbCr & _
        "Es werden alle Bilder dokumentiert.",vbOkCancel,"Abfrage")
        if Antwort = vbCancel then 
            Abbruch = True
            exit sub
        else
            Doku(0) = "0"
            Doku(1) = "1"    'alleBilder
        end if
    end if
end if

'*** Excelblatt-Überschriften ***
With objExcel
    .Workbooks.Add
    .Visible = True

'Allg(0) = DTyp / Allg(1) = DGro / Allg(2) = DAeD
'Exif(0) = EKam / Exif(1) = EAuD / Exif(2) = EGrP / Exif(3) = EBld
'Exif(4) = EBeZ / Exif(5) = EBrw / Exif(6) = EBlz / Exif(7) = EISO

    .ActiveSheet.Cells(1,1).Value = "Inhalt von " & objFolder.Path        'Ordneranzeige
    .ActiveSheet.Cells(3,2).Value = "Dateiname"                            '** Spalte B
        Spalte = 3
if Allg(0) = "1" then
        AllgSp(0) = Spalte
    .ActiveSheet.Cells(3,Spalte).Value = "Typ"                            '** Spalte C
        Spalte = Spalte + 1
end if
if Allg(1) = "1" then
        AllgSp(1) = Spalte
    .ActiveSheet.Cells(3,Spalte).Value = "Byte"                            '** Spalte D
        Spalte = Spalte + 1
end if
if Allg(2) = "1" then
        AllgSp(2) = Spalte
.ActiveSheet.Cells(3,Spalte).Value = "Änder.-Datum"                        '** Spalte E
        Spalte = Spalte + 1
end if
if Exif(0) = "1" then
        ExifSp(0) = Spalte
.ActiveSheet.Cells(3,Spalte).Value = "Kamera"                            '** Spalte F
        Spalte = Spalte + 1
end if
if Exif(1) = "1" then
        ExifSp(1) = Spalte
.ActiveSheet.Cells(3,Spalte).Value = "Aufn.-Datum"                        '** Spalte G
        Spalte = Spalte + 1 
end if
if Exif(2) = "1" then
        ExifSp(2) = Spalte
.ActiveSheet.Cells(3,Spalte).Value = "Pixel"                            '** Spalte H
        Spalte = Spalte + 1
end if
if Exif(3) = "1" then
        ExifSp(3) = Spalte
.ActiveSheet.Cells(3,Spalte).Value = "Bld."                                '** Spalte I
        Spalte = Spalte + 1
end if
if Exif(4) = "1" then
        ExifSp(4) = Spalte
.ActiveSheet.Cells(3,Spalte).Value = "Zeit"                                '** Spalte J
        Spalte = Spalte + 1
end if
if Exif(5) = "1" then
        ExifSp(5) = Spalte
'Eintrag Brennweite siehe unten nach Formatierung                        '** Spalte K + L
        Spalte = Spalte + 2
end if
if Exif(6) = "1" then
        ExifSp(6) = Spalte
.ActiveSheet.Cells(3,Spalte).Value = "Blitz"                            '** Spalte M
        Spalte = Spalte + 1
end if
if Exif(7) = "1" then
        ExifSp(7) = Spalte
.ActiveSheet.Cells(3,Spalte).Value = "ISO"                                '** Spalte N
        Spalte = Spalte + 1
end if
EndSpalte = Spalte
End With

if debuging then
    for n = 0 to 7 : InfoTe = InfoTe & ExifSp(n) & "/" : next
    msgbox "Spalten = " & AllgSp(0) & "/" & AllgSp(1) & "/" & AllgSp(2) & "-" & InfoTe
end if
'*** Dateien-Dokumentation ***
Zeile = 4                                                                'erste Tabellenzeile

if Doku(0) = "1" then                                                    'ausgew. Bilder
    For n=0 to imagecount-1
        set objFile = objFS.GetFile(FF_GetImageName(n))
        call Tabellenerstellung        
    Next
else
    For Each objFile In objFolder.Files                                    'Dateien-Auflistung
        call Tabellenerstellung
    Next
end if

call Tabellenabschluss

End sub

'****************************************************************************************************
Sub Tabellenerstellung()

With objExcel
'Allgemeine Daten
    strExt = objFS.GetExtensionName(objFile.Name)                         'Datei-Extension ermitteln
        
    if instr(Ucase(BFilter), Ucase(strExt)) > 0 or Doku(2) = "1" then    'alle Bilder oder alle Dateien
    
                FileAnzahl = FileAnzahl + 1                                'Dateianzahl gesamt
                DatGross = DatGross + objFile.Size                        'Dateigrößen gesamt
                
    
            .ActiveSheet.Cells(Zeile,2).Value = objFile.Name                '** Spalte A - Name
                Spalte = 3
        if Allg(0) = "1" then
            .ActiveSheet.Cells(Zeile,Spalte).Value = UCase(strExt)            '** Spalte B - Extension
                Spalte = Spalte + 1
        end if
        if Allg(1) = "1" then
            .ActiveSheet.Cells(Zeile,Spalte).Value = objFile.Size            '** Spalte C - Größe
                Spalte = Spalte + 1
        end if
        if Allg(2) = "1" then
                AeDatum = objFile.DateLastModified                            'Änderungsdatum
                AeDatum = mid(AeDatum,7,4) & ":" & mid(AeDatum,4,2) & ":" & left(AeDatum,2) & " " & mid(AeDatum,12)
            .ActiveSheet.Cells(Zeile,Spalte).Value = AeDatum                '** Spalte Änderungsdatum
                Spalte = Spalte + 1
        end if
        
'Exif-Daten
        
        if Ucase(strExt) = "JPG" then
            FileN = objFolder & "\" & objFile.Name                                    'Bild laden
            FF_LoadImage FileN

            if FF_HasExif() then
                if Exif(0) = "1" then
                    .ActiveSheet.Cells(Zeile,Spalte).Value = FF_GetExifTag(Kamera)            '** Spalte F - Kamera
                        Spalte = Spalte + 1
                end if
                if Exif(1) = "1" then
                    .ActiveSheet.Cells(Zeile,Spalte).Value = FF_GetExifTag(AufnDatum)        '** Spalte G - Aufnahmedatum
                        Spalte = Spalte + 1
                end if
                if Exif(2) = "1" then
                        Breite = FF_GetImageWidth()                                            'Größe in Pixel
                        Hoehe = FF_GetImageHeight()
                    .ActiveSheet.Cells(Zeile,Spalte).Value = Breite & " x " & Hoehe            '** Spalte H
                        Spalte = Spalte + 1
                end if
                if Exif(3) = "1" then
                    .ActiveSheet.Cells(Zeile,Spalte).Value = FF_GetExifTagAdvanced(Blende)    '** Spalte I - Blende
                        Spalte = Spalte + 1
                end if
                if Exif(4) = "1" then
                    .ActiveSheet.Cells(Zeile,Spalte).Value = "'" & FF_GetExifTagAdvanced(Zeit)    '** Spalte J - Zeit
                        Spalte = Spalte + 1
                end if
                if Exif(5) = "1" then
                        InfoTe = FF_GetExifTag(BrennwKB)
                        if InfoTe = "" then 
                            InfoTe = FF_GetExifTag(Brennweite)
                    .ActiveSheet.Cells(Zeile,Spalte).Value = "OG "                            '** Spalte K - OG-Brennw.
                            Pos = instr(InfoTe,".")                                        '
                            if Pos > 0 then                                             '
                                InfoTe = left(InfoTe,Pos-1) & "," & mid(Pos+1,1)        '
                            else                                                         'alternativ
                                InfoTe = InfoTe                                            '
                            end if                                                        '
                        else                                                             '
                    .ActiveSheet.Cells(Zeile,Spalte).Value = "KB "                            '** Spalte K - KB-Brennw.
                        end if
                        Spalte = Spalte + 1
                    .ActiveSheet.Cells(Zeile,Spalte).Value = InfoTe                            '** Spalte L - Brennweite
                        Spalte = Spalte + 1
                end if
                if Exif(6) = "1" then
                        InfoTe = FF_GetExifTag(Blitz)
                        InfoTz = InfoTe / 2 : InfoTZ = InfoTZ - Int(InfoTz)
                        if  InfoTz > 0 then InfoTe = "Ein" else InfoTe = "Aus"
                    .ActiveSheet.Cells(Zeile,Spalte).Value = InfoTe                            '** Spalte M - Blitz
                        Spalte = Spalte + 1
                end if
                if Exif(7) = "1" then
                        InfoTe = FF_GetExifTag(ISO)
                        if InfoTe = "" then InfoTe = "---"
                    .ActiveSheet.Cells(Zeile,Spalte).Value = InfoTe                            '** Spalte N - ISO
                        Spalte = Spalte +1
                end if
            else
                'keine Exif-Daten vorhanden
                '.ActiveSheet.Cells(Zeile,Spalte).Value = " Keine Exif-Daten vorhanden"
            end if
        end if

        Zeile = Zeile + 1        
    end if

End With
End sub

'**************************************************************************************
Sub Tabellenabschluss()

With objExcel

    Zeile = Zeile + 1
    ZusText = "Zusammenfassung: " & FileAnzahl & " Dateien mit insgesamt " _
              & FormatNumber(DatGross,0,,-2) & " Byte"
    .ActiveSheet.Cells(Zeile,1).Value = ZusText                            'Zusammenfassung
        .Range("A" + Cstr(Zeile)).Select
        .Selection.Font.FontStyle = "Fett"                                'Schrift Fett

'Formatierung
'chr(65) = A,66=B,67=C,68=D,69=E,70=F,71=G,72=H,73=I,74=J,75=K,76=L,77=M,78=N

    .Range("A1").Select    
    .Selection.Font.FontStyle = "Fett"            'Schrift Fett
    .Selection.ColumnWidth = 1                    'Spaltenbreite 1 setzen
    
    .Rows("3:3").Select
    .Selection.Font.FontStyle = "Fett"            'Schrift Fett

if Allg(1) = "1" then                                                    'Dateigröße in Byte
    'msgbox "Dateigröße = Spalte " & chr(64+AllgSp(1))
    .Columns(chr(64+AllgSp(1))).Select
    .Selection.NumberFormat = "#,##0"            'Formatierung der Größen
end if

if Exif(3) = "1" then                                                    'Blende
    'msgbox "Blende = " & chr(64+ExifSp(3))
    .Columns(chr(64+ExifSp(3)) & ":" & chr(64+ExifSp(3))).Select
    .Selection.NumberFormat = "0.0"                'Formatierung der Größe
    .Selection.HorizontalAlignment = xlRight    'Rechtsbündige Anordnung
end if

    .Columns("B:N").Select
    .Selection.Columns.AutoFit                    'Optimierung der Spaltenbreite

if Exif(5) = "1" then                                                    'Brennweite
    'msgbox "Brennweite = " & chr(65+ExifSp(5))
    .Columns(chr(65+ExifSp(5)) & ":" & chr(65+ExifSp(5))).Select
    .Selection.NumberFormat = "0.0"                'Formatierung der Größe
    .Selection.HorizontalAlignment = xlRight    'Rechtsbündige Anordnung
    'Brennweitenbenennung
    .ActiveSheet.Cells(3,exifSp(5)).Value = "Brennw."
    'Erläuterung zu OG und KB eintragen
    .ActiveSheet.Cells(Zeile+1,exifSp(5)).Value = "OG=Original"
    .ActiveSheet.Cells(Zeile+2,exifSp(5)).Value = "KB=Kleinbild"
end if

End With

End Sub

'*********************************************************************
Sub ExcelGitter()
With objExcel
    .Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    .Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With .Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With .Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With .Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With .Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With .Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With .Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
End With

End Sub
'*********************************************************************
Sub SeiteFormatieren()
'Form(0) = HochFormat / Form(1) = QuerFormat
'Seit(0) = Rand oben / Seit(1) = Rand unten / Seit(2) = Rand links / Seit(3) = Rand rechts

With objExcel
    With .ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$3"        'Wiederholungszeilen 1 bis 3
        .PrintTitleColumns = ""
        
        .LeftFooter = "&F"                'F=Dateiname  A=Tabellenname D=aktualisiertes Datum
        .CenterFooter = ""
        .RightFooter = "von &N Blatt &P"
        
      if Form(0) = "1" then
          .Orientation = xlPortrait        'Hochformat
      else
        .Orientation = xlLandscape        'Querformat
      end if
      
if debuging then msgbox "Seitenränder = " & Seit(0) & "/" & Seit(1) & "/" & Seit(2) & "/" & Seit(3)

Rand = fix(Seit(0))
if Rand < cDbl(Seit(0)) then
        .TopMargin = objExcel.Application.CentimetersToPoints(Rand+.5)        'Rand oben
        .HeaderMargin = objExcel.Application.CentimetersToPoints(Rand+.5)    'Kopfzeile
else
        .TopMargin = objExcel.Application.CentimetersToPoints(Rand)            'Rand oben
        .HeaderMargin = objExcel.Application.CentimetersToPoints(Rand)        'Kopfzeile
end if
Rand = fix(Seit(1))
if Rand < cDbl(Seit(1)) then
        .BottomMargin = objExcel.Application.CentimetersToPoints(Rand+.5)    'unten
        .FooterMargin = objExcel.Application.CentimetersToPoints(Rand)        'Fußzeile
else
        .BottomMargin = objExcel.Application.CentimetersToPoints(Rand)        'unten
        .FooterMargin = objExcel.Application.CentimetersToPoints(Rand-.5)    'Fußzeile
end if
Rand = fix(Seit(2))
if Rand < cDbl(Seit(2)) then
        .LeftMargin = objExcel.Application.CentimetersToPoints(Rand+.5)        'links
else
        .LeftMargin = objExcel.Application.CentimetersToPoints(Rand)        'links

end if
Rand = fix(Seit(3))
if Rand < cDbl(Seit(3)) then
        .RightMargin = objExcel.Application.CentimetersToPoints(Rand+.5)     'rechts
else
        .RightMargin = objExcel.Application.CentimetersToPoints(Rand)        'rechts
end if

    End With
End With
End Sub

'********************************************************************
'********************************************************************
'Dialogbehandlung
'********************************************************************
sub Dialogaufruf()
'** Start Dialog Dateien-Doku **
FF_AddDialog "Dateien-Doku",170,224
FF_AddControl "Dateien-Doku","Bildfilter","GROUP",5,175,160,25
FF_AddControl "Dateien-Doku","Einstellungen","GROUP",5,10,70,160
FF_AddControl "Dateien-Doku","Dokumentation","GROUP",10,20,60,45
FF_AddControl "Dateien-Doku","ausgBld","BOOL",15,30,8,8
FF_SetControlStyle "Dateien-Doku","ausgBld",16384
FF_AddControl "Dateien-Doku","ausgew. Bilder","STATIC",30,28,38,11
FF_AddControl "Dateien-Doku","alleBld","BOOL",15,40,8,8
FF_SetControlStyle "Dateien-Doku","alleBld",16384
FF_AddControl "Dateien-Doku","alle Bilder","STATIC",30,38,38,11
FF_AddControl "Dateien-Doku","alleDat","BOOL",15,50,8,8
FF_SetControlStyle "Dateien-Doku","alleDat",16384
FF_AddControl "Dateien-Doku","alle Dateien","STATIC",30,48,38,11
FF_AddControl "Dateien-Doku","Excel-Blatt","GROUP",10,70,60,95
FF_AddControl "Dateien-Doku","HForm","BOOL",15,80,8,8
FF_SetControlStyle "Dateien-Doku","HForm",16384
FF_AddControl "Dateien-Doku","Hochformat","STATIC",30,78,38,11
FF_AddControl "Dateien-Doku","QForm","BOOL",15,90,8,8
FF_SetControlStyle "Dateien-Doku","QForm",16384
FF_AddControl "Dateien-Doku","Querformat","STATIC",30,88,38,11
FF_AddControl "Dateien-Doku","Seitenränder:","STATIC",15,105,38,11
FF_AddControl "Dateien-Doku","oben","STATIC",15,120,20,11
FF_AddControl "Dateien-Doku","Roben","COMBO",40,120,25,10
FF_AddControl "Dateien-Doku","unten","STATIC",15,130,20,11
FF_AddControl "Dateien-Doku","Runten","COMBO",40,130,25,10
FF_AddControl "Dateien-Doku","links","STATIC",15,140,20,11
FF_AddControl "Dateien-Doku","Rlinks","COMBO",40,140,25,10
FF_AddControl "Dateien-Doku","rechts","STATIC",15,150,20,11
FF_AddControl "Dateien-Doku","Rrechts","COMBO",40,150,25,10
FF_AddControl "Dateien-Doku","Daten","GROUP",80,10,85,160
FF_AddControl "Dateien-Doku","Allgemein","GROUP",85,20,75,43
FF_AddControl "Dateien-Doku","DTyp","BOOL",90,30,8,8
FF_AddControl "Dateien-Doku","Dateityp","STATIC",105,28,33,11
FF_AddControl "Dateien-Doku","DGro","BOOL",90,40,8,8
FF_AddControl "Dateien-Doku","Dateigröße (Byte)","STATIC",105,38,45,11
FF_AddControl "Dateien-Doku","DAeD","BOOL",90,50,8,8
FF_AddControl "Dateien-Doku","Änderungsdatum","STATIC",105,48,45,11
FF_AddControl "Dateien-Doku","Exif (nur bei Bilder)","GROUP",85,70,75,95
FF_AddControl "Dateien-Doku","EKam","BOOL",90,80,8,8
FF_AddControl "Dateien-Doku","Kameratyp","STATIC",105,78,47,11
FF_AddControl "Dateien-Doku","EAuD","BOOL",90,90,8,8
FF_AddControl "Dateien-Doku","Aufnahmedatum","STATIC",105,88,47,11
FF_AddControl "Dateien-Doku","EGrP","BOOL",90,100,8,8
FF_AddControl "Dateien-Doku","Größe (Pixel)","STATIC",105,98,47,11
FF_AddControl "Dateien-Doku","EBld","BOOL",90,110,8,8
FF_AddControl "Dateien-Doku","Blende","STATIC",105,108,47,11
FF_AddControl "Dateien-Doku","EBeZ","BOOL",90,120,8,8
FF_AddControl "Dateien-Doku","Belichtungszeit","STATIC",105,118,47,11
FF_AddControl "Dateien-Doku","EBrw","BOOL",90,130,8,8
FF_AddControl "Dateien-Doku","Brennweite","STATIC",105,128,47,11
FF_AddControl "Dateien-Doku","EBlz","BOOL",90,140,8,8
FF_AddControl "Dateien-Doku","Blitz (Ein/Aus)","STATIC",105,138,47,11
FF_AddControl "Dateien-Doku","EISO","BOOL",90,150,8,8
FF_AddControl "Dateien-Doku","Empfindl. (ISO)","STATIC",105,148,47,11
FF_AddControl "Dateien-Doku","Standard","BUTTON",32,204,33,11
FF_AddControl "Dateien-Doku","OK","BUTTON",122,203,38,11
FF_AddControl "Dateien-Doku","Filter","SLEDIT",10,185,150,10
'** End Dialog Dateien-Doku **

'** Vorbelegung des Auswahldialogs **
'mögliche Seitenränder definieren
FF_SetControl "Dateien-Doku","Roben","0,5"
FF_SetControl "Dateien-Doku","Roben","1,0"
FF_SetControl "Dateien-Doku","Roben","1,5"
FF_SetControl "Dateien-Doku","Roben","2,0"
FF_SetControl "Dateien-Doku","Roben","2,5"

FF_SetControl "Dateien-Doku","Runten","1,0"
FF_SetControl "Dateien-Doku","Runten","1,5"
FF_SetControl "Dateien-Doku","Runten","2,0"
FF_SetControl "Dateien-Doku","Runten","2,5"

FF_SetControl "Dateien-Doku","Rlinks","0,5"
FF_SetControl "Dateien-Doku","Rlinks","1,0"
FF_SetControl "Dateien-Doku","Rlinks","1,5"
FF_SetControl "Dateien-Doku","Rlinks","2,0"

FF_SetControl "Dateien-Doku","Rrechts","0,5"
FF_SetControl "Dateien-Doku","Rrechts","1,0"
FF_SetControl "Dateien-Doku","Rrechts","1,5"
FF_SetControl "Dateien-Doku","Rrechts","2,0"

end sub
'********************************************************************
Sub WertBestimmung
'Auswahlwerte
if DokuWert = "" then 
    DokuWert = "0/1/0"
    Formwert = "0/1"
    SeitenWert = "2,0/1,5/1,0/1,0"
    AllgWert = "1/1/1"
    ExifWert = "1/1/1/1/1/1/1/1"
    BFilter = BildKenn
else
    Formwert = FF_GetProfile("FF_Doku-Excel", "Formwert")
    SeitenWert = FF_GetProfile("FF_Doku-Excel", "SeitenWert")
    AllgWert = FF_GetProfile("FF_Doku-Excel", "AllgWert")
    ExifWert = FF_GetProfile("FF_Doku-Excel", "ExifWert")
    BFilter = FF_GetProfile("FF_Doku-Excel", "FilterWert")
end if
end sub
'********************************************************************
sub WerteEintrag()
'Werte eintragen
DokuWert = split(DokuWert,"/",-1)
FF_SetControl "Dateien-Doku","ausgBld",DokuWert(0)
FF_SetControl "Dateien-Doku","alleBld",DokuWert(1)
FF_SetControl "Dateien-Doku","alleDat",DokuWert(2)

FormWert = split(FormWert,"/",-1)
FF_SetControl "Dateien-Doku","HForm",FormWert(0)
FF_SetControl "Dateien-Doku","QForm",FormWert(1)

SeitenWert = split(SeitenWert,"/",-1)
FF_SetControl "Dateien-Doku","Roben",SeitenWert(0)
FF_SetControl "Dateien-Doku","Runten",SeitenWert(1)
FF_SetControl "Dateien-Doku","Rlinks",SeitenWert(2)
FF_SetControl "Dateien-Doku","Rrechts",SeitenWert(3)

AllgWert = split(AllgWert,"/",-1)
FF_SetControl "Dateien-Doku","DTyp",AllgWert(0)
FF_SetControl "Dateien-Doku","DGro",AllgWert(1)
FF_SetControl "Dateien-Doku","DAeD",AllgWert(2)

ExifWert = split(ExifWert,"/",-1)
FF_SetControl "Dateien-Doku","EKam",ExifWert(0)
FF_SetControl "Dateien-Doku","EAuD",ExifWert(1)
FF_SetControl "Dateien-Doku","EGrP",ExifWert(2)
FF_SetControl "Dateien-Doku","EBld",ExifWert(3)
FF_SetControl "Dateien-Doku","EBeZ",ExifWert(4)
FF_SetControl "Dateien-Doku","EBrw",ExifWert(5)
FF_SetControl "Dateien-Doku","EBlz",ExifWert(6)
FF_SetControl "Dateien-Doku","EISO",ExifWert(7)

FF_SetControl "Dateien-Doku","Filter",BFilter
end sub
'********************************************************************
sub Auswerten()
'Auswahl anzeigen und auswerten
do
    Taste = FF_ShowDialog("Dateien-Doku")
    
    if Taste = "ausgBld" then 
        FF_SetControl "Dateien-Doku","ausgBld","1"
        FF_SetControl "Dateien-Doku","alleBld","0"
        FF_SetControl "Dateien-Doku","alleDat","0"
    elseif Taste = "alleBld" then
        FF_SetControl "Dateien-Doku","ausgBld","0"
        FF_SetControl "Dateien-Doku","alleBld","1"
        FF_SetControl "Dateien-Doku","alleDat","0"
    elseif Taste = "alleDat" then
        FF_SetControl "Dateien-Doku","ausgBld","0"
        FF_SetControl "Dateien-Doku","alleBld","0"
        FF_SetControl "Dateien-Doku","alleDat","1"
    end if

    if Taste = "HForm" then 
        FF_SetControl "Dateien-Doku","HForm","1"
        FF_SetControl "Dateien-Doku","QForm","0"
    elseif Taste = "QForm" then
        FF_SetControl "Dateien-Doku","HForm","0"
        FF_SetControl "Dateien-Doku","QForm","1"
    end if
    
    if Taste = "OK" then 
        exit do
    elseif Taste = "CANCEL" then
        Abbruch = True
        exit do
    elseif Taste = "Standard" then
        DokuWert = ""
        call WertBestimmung
        call WerteEintrag
    end if
loop
end sub
'********************************************************************
sub RegistrySchreiben
'Auswahl in Registry sichern
Doku(0) = FF_GetControl("Dateien-Doku","ausgBld")
Doku(1) = FF_GetControl("Dateien-Doku","alleBld")
Doku(2) = FF_GetControl("Dateien-Doku","alleDat")
FF_WriteProfile "FF_Doku-Excel","DokuWert",Doku(0) & "/" & Doku(1) & "/" & Doku(2)

Form(0) = FF_GetControl("Dateien-Doku","HForm")
Form(1) = FF_GetControl("Dateien-Doku","QForm")
FF_WriteProfile "FF_Doku-Excel","FormWert",Form(0) & "/" & Form(1)

Seit(0) = FF_GetControl("Dateien-Doku","Roben")
Seit(1) = FF_GetControl("Dateien-Doku","Runten")
Seit(2) = FF_GetControl("Dateien-Doku","Rlinks")
Seit(3) = FF_GetControl("Dateien-Doku","Rrechts")
FF_WriteProfile "FF_Doku-Excel","SeitenWert",Seit(0) & "/" & Seit(1) & "/" & Seit(2) & "/" & Seit(3)

Allg(0) = FF_GetControl("Dateien-Doku","DTyp")
Allg(1) = FF_GetControl("Dateien-Doku","DGro")
Allg(2) = FF_GetControl("Dateien-Doku","DAeD")
FF_WriteProfile "FF_Doku-Excel","AllgWert",Allg(0) & "/" & Allg(1) & "/" & Allg(2)

Exif(0) = FF_GetControl("Dateien-Doku","EKam")
Exif(1) = FF_GetControl("Dateien-Doku","EAuD")
Exif(2) = FF_GetControl("Dateien-Doku","EGrP")
Exif(3) = FF_GetControl("Dateien-Doku","EBld")
Exif(4) = FF_GetControl("Dateien-Doku","EBeZ")
Exif(5) = FF_GetControl("Dateien-Doku","EBrw")
Exif(6) = FF_GetControl("Dateien-Doku","EBlz")
Exif(7) = FF_GetControl("Dateien-Doku","EISO")
FF_WriteProfile "FF_Doku-Excel","ExifWert",Exif(0) & "/" & Exif(1) & "/" & Exif(2) & "/" & Exif(3) & _
                                     "/" & Exif(4) & "/" & Exif(5) & "/" & Exif(6) & "/" & Exif(7)

BFilter = FF_GetControl("Dateien-Doku","Filter")
FF_WriteProfile "FF_Doku-Excel","FilterWert",BFilter

end sub
'********************************************************************
Auch hier wieder den Code in einen Texteditor kopieren und als VBS-Datei (z.B. ImageInfo_To_Excel.vbs) abspeichern.
Mit dem Skript werden auch die wichtigsten Exif-Infos übertragen. Eine Auswahl für die übertragung nach Excel wird angeboten.



Neue Version ab 31.07.2007 - siehe unten: Beitrag #19
 
Zuletzt bearbeitet:

W.P.

Mitglied
Dabei seit
16.10.02
Beiträge
5.099
Standort
Anzing BY
#4
AW: Dateiinfos nach Excel übertragen

Hallo Mecki14,

warum packst Du das Skript nicht einfach in eine ZIP und schiebst es in den Downloadbereich?
Falls Du keine eigenen Web-Space hast, kannst Du die ZIP an einen Beitrag hängen und vom Download-Bereich her verlinken.
Falls der Upload-Account für Dich nicht offen ist, kannst Du Micha (m.s) entsprechend per PN ansprechen.

Schönen Gruß,
Werner.
 

m.s

FF-Team
Mitarbeiter
Dabei seit
19.09.02
Beiträge
11.274
#6
AW: Dateiinfos nach Excel übertragen

Kannst du "Bilderinfo nach Excel" noch so verändern, dass es auf Wunsch auch Unterverzeichnisse in die Exceltabelle übernimmt?
 

Mecki14

Mitglied
Dabei seit
15.03.06
Beiträge
2.810
Standort
Düsseldorf
Trophäen
einige {*} {!} * !
#7
AW: Dateiinfos nach Excel übertragen

Kannst du "Bilderinfo nach Excel" noch so verändern, dass es auf Wunsch auch Unterverzeichnisse in die Exceltabelle übernimmt?
Ich werde mich mal mit dem Thema beschäftigen. Aber bitte keine schnelle Lösung erwarten - dafür brauche ich Zeit, die ja bekanntlich ein Rentner nicht hat.
 

Rabe

Mitglied
Dabei seit
11.11.03
Beiträge
1.615
Trophäen
{*!!} **** !!!!! & ¡¡ [*]!
#8
AW: Dateiinfos nach Excel übertragen

Aber als Rentier hast Du dich in diesem Forum bereits rentiert! :cool:

Danke für die Scriptlösungen auch von mir.


RAbe
 

HeiM

Mitglied
Dabei seit
08.04.03
Beiträge
5.652
Standort
Leipzig
#10
AW: Dateiinfos nach Excel übertragen

ich kann nach Download ins FF\Scripte Verzeichnis keinen Eintrag im FF Script finden ??
F11 + automat. Konfig und Neustart FF bringt keine Änderung
die zip nur in den Scriptordner kopieren. Dann FF öffnen. Aufgabenbereich öffnen. Rechtsklick auf Scripte und Automatische Konfiguration anklicken. Dann sollte es gehen.
Nicht F11 benutzen.
Siehe auch Werners (W.P.) Signatur
 

guenter_w

Mitglied
Dabei seit
27.06.02
Beiträge
5.667
Standort
Talheim
Trophäen
ja
#11
AW: Dateiinfos nach Excel übertragen

Hallo Xaver!

Existiert bei dir das Verzeichnis FixFoto\Params\Scripte? Dann gehören die ZIPs dorthin! Anschließend die automatische Scriptkonfiguration laufen lassen.

Gruß

Günter
 

Xaver

Mitglied
Dabei seit
14.06.04
Beiträge
646
Standort
Biberach-Riss
#12
AW: Dateiinfos nach Excel übertragen

Hallo Xaver!

Existiert bei dir das Verzeichnis FixFoto\Params\Scripte? Dann gehören die ZIPs dorthin! Anschließend die autmoatische Scriptkonfiguration laufen lassen.
Hallo Günter,
das Verzeichnis C:\Programme\Fixfoto enthält kein Verzeichnis Params\Scripte
Bei mir siehts so aus: C:\Programme\Fixfoto\Script, ...\Batch, ...\BatchScript, ...\Pages,

Bisher liegen alle Scripte als ZIP im Unterverzeichnis Script und funktionieren bestens.
 

Xaver

Mitglied
Dabei seit
14.06.04
Beiträge
646
Standort
Biberach-Riss
#13
AW: Dateiinfos nach Excel übertragen

die zip nur in den Scriptordner kopieren. Dann FF öffnen. Aufgabenbereich öffnen. Rechtsklick auf Scripte und Automatische Konfiguration anklicken. Dann sollte es gehen.
Nicht F11 benutzen.
Siehe auch Werners (W.P.) Signatur
Geht leider nicht.
Übrigens Werners Script tut.
 

Xaver

Mitglied
Dabei seit
14.06.04
Beiträge
646
Standort
Biberach-Riss
#14
AW: Dateiinfos nach Excel übertragen

Hurra ich habe die Lösung.
Die Scripte müssen in
"C:\Dokumente und Einstellungen\....User....\Eigene Dateien\FixFoto\Script"
stehen und nicht in C:\Programme\FixFoto\Script.
Das Unter-Verzeichnis C:\Programme\FixFoto\Script kann offensichtlich samt Inhalt gelöscht werden.

Achtung: Die Scripte sind damit userspezifisch.
 

Linley

Mitglied
Dabei seit
09.06.04
Beiträge
3.809
Standort
Rostock
Trophäen
3* 3! {!!} {*} °
#15
AW: Dateiinfos nach Excel übertragen

Hallo Xaver,

Hurra ich habe die Lösung.
Die Scripte müssen in
"C:\Dokumente und Einstellungen\....User....\Eigene Dateien\FixFoto\Script"
stehen und nicht in C:\Programme\FixFoto\Script.
Das Unter-Verzeichnis C:\Programme\FixFoto\Script kann offensichtlich samt Inhalt gelöscht werden.

Achtung: Die Scripte sind damit userspezifisch.
diese Dinge sind auch nachzulesen in [thread=9752]Neuer Speicherort für Einstellungen ab 2.84 B 86[/thread] und [thread=9754]Neuer Speicherort ab B86[/thread].

Schönen Gruß,

Martin
 

Xaver

Mitglied
Dabei seit
14.06.04
Beiträge
646
Standort
Biberach-Riss
#16
AW: Dateiinfos nach Excel übertragen

Hallo Xaver,

diese Dinge sind auch nachzulesen
Hallo Martin,

war 7 Wochen in Übersee habe nicht alles nachgelesen.
Deshalb Danke für den Hinweis

Das heisst jetzt, dass alle Scripte für jeden Nutzer extra gespeichert werden müssen.
Viel spass beim Updaten.
 
Zuletzt bearbeitet:

Linley

Mitglied
Dabei seit
09.06.04
Beiträge
3.809
Standort
Rostock
Trophäen
3* 3! {!!} {*} °
#17
AW: Dateiinfos nach Excel übertragen

Hallo Xaver,

niemand ist gezwungen, die Vorgabe unter "Dokumente und Einstellungen" zu verwenden, man kann auch die Schaltfläche In das Programm-Verzeichnis klicken, woraufhin im Programmverzeichnis der Unterordner Params angelegt wird. In diesem findest Du dann die üblichen weiteren Unterordner.
Ist auf diese Art und Weise absolut kein Problem.

Schönen Gruß,

Martin
 

Mecki14

Mitglied
Dabei seit
15.03.06
Beiträge
2.810
Standort
Düsseldorf
Trophäen
einige {*} {!} * !
#19
AW: Dateiinfos nach Excel übertragen

Kannst du "Bilderinfo nach Excel" noch so verändern, dass es auf Wunsch auch Unterverzeichnisse in die Exceltabelle übernimmt?
Angeregt durch die Frage von Micha habe ich die beiden Skripte DIR_in_XLS und ImageInfo_To_Excel vollkommen überarbeitet. Ab sofort stehen die neuen Versionen im Zubehörbereich unter Skripte/Export zur Verfügung. Bei beiden Skripten können jetzt auch Unterverzeichnisse einbezogen werden.

Beim FixFoto-Skript ImageInfo_To_Excel wurden zusätzlich einige Formatierungsänderungen vorgenommen und bei den Exif_Daten die Belichtungskorrektur hinzugefügt.


Bei Einbeziehung von Unterverzeichnissen wird die Datenmenge sehr schnell sehr groß und die Extraktion der Exif-Daten dauert entsprechend lang. Geht es nur um eine schnelle Übersicht, ist das von FixFoto unabhängige Skript DIR_in_XLS besser geeignet, da schneller.

Beim von FixFoto unabhängigen Skript DIR_in_XLS kann jetzt mit Merkmalen genau definiert werden, wie die Excel-Dokumentation aussehen soll.


Besonders zu beachten ist, dass Filter definiert werden können und bei Bilddateien, soweit vorhanden, die Exif-Daten Kameratyp und Aufnahmedatum mit ausgegeben werden.

Anmerkung:
Da die neuen vbe-Dateien die alten vbs-Dateien nicht automatisch überschreiben, die alten Dateien löschen.


Anm. Ralf Eberle: Hier geht es um Dir_in_XLS Version 3.2
 
Zuletzt bearbeitet:

Mecki14

Mitglied
Dabei seit
15.03.06
Beiträge
2.810
Standort
Düsseldorf
Trophäen
einige {*} {!} * !
#20
AW: Dateiinfos nach Excel übertragen

Die beiden Skripte DIR_in_XLS und ImageInfo_To_Excel wurden nochmal überarbeitet. Es waren noch kleine Bugs zu beseitigen.

Außerdem wurde für JPG-Bilder, unabhängig davon, ob Exif-Daten vorhanden sind
- DIR_in_XLS ergänzt um die Infos Breite x Höhe in Pixel und Gesamtanzahl der Pixel
- ImageInfo_To_Excel um die Info Gesamtanzahl der Pixel

Die Gesamtanzahl von Pixel ist u.a. interessant zur Kontrolle, ob bei veröffentlichten FF-Wettbewerbsbildern die Gesamtpixelzahl von 310.000 nicht überschritten wurde.

Die beiden überarbeiteten Versionen stehen ab sofort im Skriptbereich zur Verfügung.

Anm. Ralf Eberle: Hier geht es um Dir_in_XLS Version 3.3
 
Oben