Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1412to1416
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Bildgrößen über Bildpfad

Bildgrößen über Bildpfad
09.03.2015 21:28:47
Stefan
Hallo,
gibt es eine Möglichkeit, die Bildgröße, also Seitengrößen in Pixel einen jpgs durch Excel ermitteln zu lassen, wenn ich in einer Zelle den Pfad zum Bild habe ?
Also bspw. A=Pfad; B=Größe
Daaanke und Grüße
Stefan

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bildgrößen über Bildpfad
10.03.2015 06:48:12
Hajo_Zi
Hallo Stefan,
mit VBA geht das schon.
Option Explicit                                     ' Variablendefinition erforderlich
'* erstellt von Nepumuk                                                         *
'* http:// _
www.online-excel.de/fom/fo_read.php?f=1&bzh=1259&h=1256&ao=1#a123x
Public DoHohe As Double                             ' Bildhöhe Original
Public DoBreite As Double                           ' Bildbreite Original
Private Declare Function CreateIC Lib "GDI32.dll" Alias "CreateICA" ( _
ByVal lpDriverName As String, _
ByVal lpDeviceName As String, _
ByVal lpOutput As String, _
ByRef lpInitData As Any) As Long
Private Declare Function DeleteDC Lib "GDI32.dll" ( _
ByVal hDC As Long) As Long
Private Declare Function GetDeviceCaps Lib "GDI32.dll" ( _
ByVal hDC As Long, _
ByVal nIndex As Long) As Long
Private Declare Function MulDiv Lib "Kernel32.dll" ( _
ByVal nNumber As Long, _
ByVal nNumerator As Long, _
ByVal nDenominator As Long) As Long
Private Const LOGPIXELSX = 88&
Private Const LOGPIXELSY = 90&
Private Const HimetricInch = 2540&
Sub Auslesen()
Bildgroesse_auslesen "C:\Test.jpg"
End Sub
Sub Bildgroesse_auslesen(strPicturePath As String)
Dim MyPicture As StdPicture
'    Dim dblPixelX As Long, dblPixelY As Long
Set MyPicture = LoadPicture(strPicturePath)
'   es wird nur die Höhe benötigt für Faktor
'    dblPixelX = HimetricToPixelsX(MyPicture.Width)
'    dblPixelY = HimetricToPixelsY(MyPicture.Height)
DoBreite = HimetricToPixelsX(MyPicture.Width)
DoHohe = HimetricToPixelsY(MyPicture.Height)
'    MsgBox "Breite in Pixel " & CStr(dblPixelX) & vbLf & _
'        "Höhe in Pixel  " & CStr(dblPixelY)
'    MsgBox "Breite in Zoll " & CStr(dblPixelX / 72) & vbLf & _
'        "Höhe in Zoll  " & CStr(dblPixelY / 72)
'    MsgBox "Breite in mm " & CStr(dblPixelX * 0.352777777777778) & vbLf & _
'        "Höhe in mm  " & CStr(dblPixelY * 0.352777777777778)
Set MyPicture = Nothing
End Sub
Function HimetricToPixelsX(ByVal inHimetric As Long) As Long
HimetricToPixelsX = ConvertPixelHimetric(inHimetric, True, True)
End Function
Function HimetricToPixelsY(ByVal inHimetric As Long) As Long
HimetricToPixelsY = ConvertPixelHimetric(inHimetric, True, False)
End Function
Function ConvertPixelHimetric(ByVal inValue As Long, _
ByVal ToPix As Boolean, inXAxis As Boolean) As Long
Dim TempIC As Long, GDCFlag As Long
TempIC = CreateIC("DISPLAY", vbNullString, vbNullString, ByVal 0&)
If (TempIC) Then
If (inXAxis) Then GDCFlag = LOGPIXELSX Else GDCFlag = LOGPIXELSY
If (ToPix) Then ConvertPixelHimetric = MulDiv(inValue, _
GetDeviceCaps(TempIC, GDCFlag), HimetricInch) _
Else ConvertPixelHimetric = MulDiv(inValue, _
HimetricInch, GetDeviceCaps(TempIC, GDCFlag))
Call DeleteDC(TempIC)
End If
End Function

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige