Kleines Skript zum Kopieren der wichtigsten Exifs

[Erdbaehr]

Hi,

ich benötige ein Skript, mit dem ich die wichtigsten EXIF-Daten des geladenen Bildes sofort in Textform in die Zwischenablage bekomme. Mich interessieren nur folgende Informationen

• Hersteller / Modell
• Datum
• Uhrzeit
• Brennweite (mit Umrechnung ins KB-Format)
• Blende
• Belichtungszeit
• Belichtungskorrektur
• ISO

Dabei sollen nur die Werte ausgegeben werden, nicht deren Namen. Beispiel:

• Fujifilm S100FS
• 03.10.2009
• 17:15:00
• 14.0 (KB: 55)mm
• F7.1
• 1/600s
• +/- 0.0EV
• ISO200

Im Skriptingbereich habe ich nichts passendes gefunden. Das Skript "CopyExif" ist schon prima, aber schon zu mächtig. Leider verstehe ich nichts von der Skriptprogrammierung, sonst würde ich mir das eben selbst zusammenbasteln. Wer kann helfen?

LG
Erdbähr

 

[W.P.]

AW: Kleines Skript zum Kopieren der wichtigsten Exifs

Hallo,
mal schnell zusammengestopselt (Natürlich auch als Download im Anhang):

'FFName="Kopiert ausgesuchte Exifdaten in die Zwischenablage"
'FFSubmenu="Exif"
Option Explicit

Main
Sub Main
	FF_TextToClipboard ReadExifTags()
	'MsgBox ReadExifTags()
End Sub

Function ReadExifTags()
	Dim sReturn
	Dim sDate
	Dim dDate
	
	ReadExifTags = ""
	If FF_HasExif() = False Then Exit Function
	
	sReturn = sReturn & vbNewLine & FF_GetExifTag("Make") & " " & Trim(Replace(FF_GetExifTag("Model"), FF_GetExifTag("Make"), ""))
	sDate = FF_GetExifTag("DateTimeOriginal")
	If Len(sDate) > 0 Then
		dDate = ConvertEXIF2VarDate(sDate)
		If VarType(dDate) = vbEmpty Then
			sReturn = sReturn & vbNewLine & vbNewLine
		Else
			sReturn = sReturn & vbNewLine & FormatDateTime(dDate, vbShortDate)
			sReturn = sReturn & vbNewLine & FormatDateTime(dDate, vbLongTime)
		End If
	Else
		sReturn = sReturn & vbNewLine & vbNewLine
	End If
		
	sReturn = sReturn & vbNewLine & FF_GetExifTagAdvanced("FocalLength") & "mm"
	sReturn = sReturn & vbNewLine & "f/" & FF_GetExifTagAdvanced("FNumber")
	sReturn = sReturn & vbNewLine & FF_GetExifTagAdvanced("ExposureTime") & "s"
		sReturn = sReturn & vbNewLine & Round(CDbl(FF_GetExifTag("ExposureBiasValue")), 1) & "EV"
	sReturn = sReturn & vbNewLine & "ISO " & FF_GetExifTag("ISOSpeedRatings")
	
	ReadExifTags = Mid(sReturn, 3)
End Function

Function ConvertEXIF2VarDate(sExifDateTime)
	Dim sJahr
	Dim sTag
	Dim sMonat
	Dim sStunde
	Dim sMinute
	Dim sSekunde
	
	ConvertEXIF2VarDate = Empty
	If Len(sExifDateTime) > 0 Then
		sTag = Mid(sExifDateTime, 9, 2)
		sMonat = Mid(sExifDateTime, 6, 2)
		sJahr = Left(sExifDateTime, 4)
		sStunde = Mid(sExifDateTime, 12, 2)
		sMinute = Mid(sExifDateTime, 15, 2)
		sSekunde = Mid(sExifDateTime, 18, 2)
		If IsNumeric(sTag) = False Then Exit Function
		If IsNumeric(sMonat) = False Then Exit Function
		If IsNumeric(sJahr) = False Then Exit Function
		If CLng(sTag) = 0 Then Exit Function
		If CLng(sMonat) = 0 Then Exit Function
		If CLng(sJahr) = 0 Then Exit Function
		
		If IsNumeric(sStunde) = False Or IsNumeric(sMinute) = False Or IsNumeric(sSekunde) = False Then Exit Function
		
		ConvertEXIF2VarDate = DateSerial(sJahr, sMonat, sTag) + TimeSerial(sStunde, sMinute, sSekunde)
	End If
End Function

 

[Erdbaehr]

AW: Kleines Skript zum Kopieren der wichtigsten Exifs

Lieber W.P,

ganz herzlichen Dank für die Mühe, die Du Dir Dir gemacht hast!!!
Es es genau so, wie ich es haben wollte und funktioniert super! :-*

Viele Grüße
Erdbähr