Clever-Excel-Forum

Guten Morgen alle zusammen,
ich bräuchte mal wieder eure hilfe und zwar habe ich eine Excel-Datei in der Ein Commandbutton dafür sorgt das die Kamera geöffnet wird und danach der Dateiexplorer zum auswählen des Bildes, das Bild wird dann automatisch skaliert und an der dafür vorgesehen Stelle eingefügt.
Mein Problem dabei ist das sich der Dateiordner indem sich die Kameraapp befindet sich bei jedem Update verändert, sprich ich müsste den Dateiordner Variabel definieren. Dazu fehlen mir leider die Kenntnisse....
Desweiteren wäre es sehr schön wenn die Kamera ausgelöst hat, sich diese schließt und automatisch das letzte Bild aus dem Ordner "Eigene Aufnahmen" (C:\Users\Name\Pictures\Camera Roll) herrausholt und einfügt. Also ohne das sich der Dateiexplorer öffnet und man es händisch auswählen muss. Dies wäre allerdings zweitrangig.
Ich bedanke mich im Vorraus für jeden der mir hilft.

Code:
Private Sub CommandButton2_Click()

file = "C:\Programme\WindowsApps\Microsoft.WindowsCamera_2022.2209.13.0_x64__8wekyb3d8bbwe\WindowsCamera.exe" 'definiert den Pfad der Kamera

Shell (file) 'Öffnet die Kamera

Dim lngTMP As Long 'Löst das einfügen eines Bildes aus

    With Me

        lngTMP = .Shapes.Count

        Application.CommandBars.FindControl(ID:=2619).Execute

        If .Shapes.Count > lngTMP Then 'Skaliert das Bild und fügt es an die richtige Position ein

            With .Shapes(.Shapes.Count)

                .LockAspectRatio = msoFalse

        .Width = [C5:E12].Width

        .Height = [C5:E12].Height

        .Left = [C5].Left

        .Top = [C5].Top

    End With

    End If

End With

End Sub

Hallöchen,

schaue Dir mit Dir den Inhalt von C:\Programme\WindowsApps\ an und wenn der String mit "C:\Programme\WindowsApps\Microsoft.WindowsCamera" beginnt, dann übernimmst Du ihn und setzt die App hintendran.

Hallöchen,
habe nun ein weilchen rumprobiert allerdings krieg ich es nicht zum laufen.
Den Ordner "WindowsApps" kann ich nicht öffnen.
Und über die Dir funktion kommt immer die Fehlermeldung Datei nicht gefunden.
Ist es Möglich das Makro so umzuschreiben das er einfach den Ordner Windowsapps und dessen Unterordner nach der Kamera App durchsucht und diese dann öffnet?

Danke für deine Hilfe!

Google sagt, dass Du hier mal schauen solltest

Stack Overflow
how to capture picture using webcam in vb6.0 - forum - developer Fusion
excel - How to use webcam capture on a Microsoft Access form? - Stack Overflow

Hallöchen,

wenn Dir Dir den Fehler bringt, dann geht das so nicht.
Der Ordner an sich benötigt spezielle Admin-Zugriffsrechte.

Eventuell kann das und der darin verlinkte weitere Thread helfen:
stackoverflow.-how-to-list-all-installed-applications-in-to-excel

So ist eventuell schon Lange her, aber vielleicht hat mal jemand anderes ein ähnliches Problem.
Der Ordner "WindowsApps" ist Lese und Schreibgeschützt. dadurch lässt sich der Ordnername nicht Variabel deklarieren. Immerhin existiert dieser Ordner nicht für Excel.
Das automatisch das letzte Bild aus dem Ordner eingefügt wird, hat mittlerweile funktioniert.
Also für alle die ähnliche Vorhaben umsetzen wollen, hier ist mein Code:

Code:
Private Sub CommandButton2_Click()

ActiveSheet.Unprotect Password:="" 'Blattschutz aufheben

file = ActiveWorkbook.Worksheets("Tabelle1").Range("XFD1").Value 'Der Ordnerpfad für die Kamera befindet sich in der Tabelle

Shell (file) 'Öffnet die Kamera

 Dim folderPath As String

Dim userName As String

' Benutzernamen abrufen

userName = Environ("USERNAME")

' Ordnerpfad basierend auf dem Benutzernamen festlegen

folderPath = "C:\Users\" & userName & "\Pictures\Camera Roll\"

' Holen Sie sich den Dateinamen und das Änderungsdatum des neuesten Bildes im Ordner

Dim lastFile As String

Dim fileName As String

Dim fileDate As Date

lastFile = Dir(folderPath & "*.jpg", vbNormal)

Do While Len(lastFile) > 0

    If FileDateTime(folderPath & lastFile) > fileDate Then

        fileName = lastFile

        fileDate = FileDateTime(folderPath & lastFile)

    End If

    lastFile = Dir

Loop

    'Fügen Sie das neueste Bild in die Excel-Datei ein

    If Len(fileName) > 0 Then

        filePath = folderPath & fileName

        With ActiveSheet.Pictures.Insert(filePath)

            'Passen Sie die Größe und Position des Bildes an

            .ShapeRange.LockAspectRatio = msoFalse

            .Width = Range("F5:H12").Width

            .Height = Range("F5:H12").Height

            .Left = Range("F5").Left

            .Top = Range("F5").Top

        End With

    Else

        MsgBox "Kein Bild gefunden"

    End If

End Sub

K.M.Kay

schauan

K.M.Kay

Warkings

schauan

K.M.Kay