Zurück zur Homepage

Grafiken aus Zwischenablage einfügen

Grafikdateien, die im Explorer mit "Kopieren" in die Zwischenablage gebracht wurden (als Dateiliste), können durch Klick auf den Button ins Blatt eingefügt werden.

Beispieldatei (dateienausclip.zip 14 KB)

Option Explicit
Private Declare Function CloseClipboard Lib _
    "user32" () As Long
Private Declare Function OpenClipboard Lib _
    "user32" (ByVal hWnd As Long) As Long
Private Const CF_HDROP = 15
'Zum Holen der Dateiliste
Private Declare Function GetClipboardData Lib _
    "user32" (ByVal wFormat As Long) As Long
Private Declare Function IsClipboardFormatAvailable _
    Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function DragQueryFile Lib "shell32.dll" _
    Alias "DragQueryFileA" (ByVal hDrop As Long, _
    ByVal UINT As Long, ByVal lpStr As String, _
    ByVal ch As Long) As Long


Public Sub TestBilderEinfügen()
Dim a, i As Long
On Error Resume Next
With Sheets("Tabelle1")
    a = DateilisteGrafikAusClipboard
    i = UBound(a)
    If i = 0 Then MsgBox "Keine Grafik ausgewählt": Exit Sub
    For i = 1 To i
        .Pictures.Insert a(i)
    Next
End With
End Sub


'Hiermit wird die Liste aus der Zwischenablage gelesen.
Private Function DateilisteGrafikAusClipboard()
Dim Quelldatei As String, b As String 'Buffer
Dim lngZeiger As Long, lngAnzahl As Long
Dim zähler As Long, Ret As Long, Anzahl As Long
Dim Liste() As String, isGrafik As Boolean
'Wenn Clipboard-Format Fileliste ist, dann ...
If IsClipboardFormatAvailable(CF_HDROP) Then
    OpenClipboard 0&
    'Zeiger holen
    lngZeiger = GetClipboardData(CF_HDROP)
    'Anzahl Dateien in der Liste ermitteln
    lngAnzahl = DragQueryFile(lngZeiger, -1&, "", 0)
    ReDim Liste(1 To lngAnzahl)
    For zähler = 0 To lngAnzahl - 1
        isGrafik = True
        'Buffer erzeugen
        b = String(256, 0)
        'Eine Datei aus Liste mit dem Index zähler holen
        'die Anzahl Zeichen werden zurückgegeben

        Ret = DragQueryFile(lngZeiger, zähler, b, 255)
        'Überprüfen, ob Grafik
        Select Case LCase(Right$(Left$(b, Ret), 3))
            Case "jpg"
            Case "gif"
            Case "bmp"
            'Andere Formate wie vorher
            Case Else
                isGrafik = False
        End Select
        If isGrafik Then
            'String wird in Liste abgelegt
            Anzahl = Anzahl + 1
            Liste(Anzahl) = Left$(b, Ret)
        End If
    Next
    ReDim Preserve Liste(1 To Anzahl)
    CloseClipboard
    DateilisteGrafikAusClipboard = Liste
End If
End Function