Daten einlesen

Forumthread: Daten einlesen

Daten einlesen

03.02.2007 09:24:00

Franka

Hallo zusammen,
Wie kann ich per VBA Höhe und Breite von jpg.-Bildern eines Ordners in eine Excelliste einlesen, ohne die Bilder zu öffnen.
Vielen Dank aus Bremen
Franka

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Daten einlesen

03.02.2007 09:40:51

Josef
AW: Daten einlesen

03.02.2007 14:22:45

Franka

AW: Daten einlesen

03.02.2007 09:40:51

Josef

Hallo Franka,
probier mal.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit
'Code aus "Online Excel Forum" - http://www.online-excel.de/
'Postet by Nepumuk, 20/06/05
'Geändert von J.Ehrensberger 08/02/06
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&

Public Function GetImageSize(ByVal strPicturePath As String, ByRef dblWidth As Double, ByRef dblHeight As Double) As Long
    Dim MyPicture As StdPicture
    On Error GoTo ErrExit
    Set MyPicture = LoadPicture(strPicturePath)
    If Not MyPicture Is Nothing Then
        GetImageSize = -1
        dblWidth = HimetricToPixelsX(MyPicture.Width)
        dblHeight = HimetricToPixelsY(MyPicture.Height)
    End If
    ErrExit:
    Err.Clear
    On Error GoTo 0
    Set MyPicture = Nothing
End Function

Private Function HimetricToPixelsX(ByVal inHimetric As Long) As Long
    HimetricToPixelsX = ConvertPixelHimetric(inHimetric, True, True)
End Function

Private Function HimetricToPixelsY(ByVal inHimetric As Long) As Long
    HimetricToPixelsY = ConvertPixelHimetric(inHimetric, True, False)
End Function

Private 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
'#

Public Sub Test()
    Dim w As Double, h As Double
    Dim objFS As FileSearch
    Dim strPath As String
    Dim intIndex As Integer


    strPath = "C:\Dokumente und Einstellungen\Admin\Eigene Dateien\Eigene Bilder\Misc" 'Pfadanpassen!

    Set objFS = Application.FileSearch

    With objFS
        .NewSearch
        .LookIn = strPath
        .Filename = "*.jpg"
        .SearchSubFolders = False

        If .Execute > 0 Then

            For intIndex = 1 To .FoundFiles.Count

                GetImageSize .FoundFiles(intIndex), w, h
                Cells(intIndex + 1, 1) = .FoundFiles(intIndex)
                Cells(intIndex + 1, 2) = w
                Cells(intIndex + 1, 3) = h

            Next

        End If

    End With

    Set objFS = Nothing



End Sub

Gruß Sepp

AW: Daten einlesen

03.02.2007 14:22:45

Franka

Hallo Sepp,
Super, genau das ist es. Vielen Dank.
Franka

Beliebteste Forumthreads (12 Monate)

Forumthread: Daten einlesen

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread