Bild aus Userform in bestimmte Zeile einfügen

Private Sub cobo_hinterlegtebudgets_Change() Dim nMBild As String Dim nBBild As String Dim AnzahlBudgets, n As Integer Dim pct As Object 'On Error Resume Next AnzahlBudgets = Worksheets("Datenbank_hinterlegteBudgets").Range("F1") For n = 4 To AnzahlBudgets + 4 If usf_RichtpreisgenS2.cobo_hinterlegtebudgets.Value = Worksheets(" _ Datenbank_hinterlegteBudgets").Cells(n, 6) Then nMBild = Worksheets("Datenbank_hinterlegteBudgets").Cells(n, 3) nBBild = Worksheets("Datenbank_hinterlegteBudgets").Cells(n, 5) Img_Machine_hb.Picture = LoadPicture("K:\Eigene_Dateien\" _ & nMBild & ".jpg") Worksheets("strg").Range("m28") = nMBild On Error Resume Next Img_Beutel_hb.Picture = LoadPicture("K:\Eigene_Dateien\" _ & nBBild & ".jpg") End If Next n End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

....... nMBild = "K:\Eigene_Dateien\" & nMBild & ".jpg" Img_Machine_hb.Picture = LoadPicture(nMBild) With Worksheets("strg") Set pct = .Pictures.Insert(nMBild) With .Range("m28") pct.Top = .Top pct.Left = .Left End With End With ......

Hallo,
ich habe einen Code von Nepumuk gefunden, der genau das machen soll, was ich gerne möchte, jedoch
passiert leider nichts.
Hier mal der Code. Hat jemand eine Ahnung was ich noch falsche mache?
Die Bilder liegen im jpeg-Format auf der Festplatte.
Option Explicit
Private Declare Function CopyImage Lib "user32.dll" ( _
ByVal handle As Long, _
ByVal imageType As Long, _
ByVal newWidth As Long, _
ByVal newHeight As Long, _
ByVal lFlags As Long) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function OpenClipboard Lib "user32.dll" ( _
ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function SetClipboardData Lib "user32.dll" ( _
ByVal wFormat As Long, _
ByVal hMem As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" ( _
ByVal hObject As Long) As Long
Private Const IMAGE_BITMAP = 0&
Private Const LR_COPYRETURNORG = &H4
Private Const CF_BITMAP = 2&


Sub MaschinenbildEinfuegen()
Dim lngTempPicture As Long
lngTempPicture = CopyImage(usf_RichtpreisgenS2.Img_Machine_hb.Picture, IMAGE_BITMAP, 0, 0,   _
_
_
_
LR_COPYRETURNORG)
If lngTempPicture  0 Then
Call OpenClipboard(Application.hwnd)
Call EmptyClipboard
Call SetClipboardData(CF_BITMAP, lngTempPicture)
Call CloseClipboard
Call DeleteObject(lngTempPicture)
Sheets("Angebot_Druck").Range("C37").Paste
End If
End Sub

Danke

Hallo,
ändere den Code so (passt für alle Excelversionen)

Option Explicit

Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
Private Declare Function CopyImage Lib "user32.dll" ( _
    ByVal handle As Long, _
    ByVal imageType As Long, _
    ByVal newWidth As Long, _
    ByVal newHeight As Long, _
    ByVal lFlags As Long) As Long
Private Declare Function OpenClipboard Lib "user32.dll" ( _
    ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function SetClipboardData Lib "user32.dll" ( _
    ByVal wFormat As Long, _
    ByVal hMem As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" ( _
    ByVal hObject As Long) As Long

Private Const IMAGE_BITMAP = 0&
Private Const LR_COPYRETURNORG = &H4
Private Const CF_BITMAP = 2&
Private Const GC_CLASSNAMEMSEXCEL = "XLMAIN"

Private Sub CommandButton1_Click()
    Dim lngTempPicture As Long

    lngTempPicture = CopyImage(Image1.Picture, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
    If lngTempPicture <> 0 Then
        Call OpenClipboard(FindWindow(GC_CLASSNAMEMSEXCEL, Application.Caption))
        Call EmptyClipboard
        Call SetClipboardData(CF_BITMAP, lngTempPicture)
        Call CloseClipboard
        Call DeleteObject(lngTempPicture)
        Tabelle1.Paste
    End If
End Sub

Private Sub UserForm_Activate()
    ' Set Image1.Picture = LoadPicture("D:\Eigene Dateien\Eigene Bilder\babymitknopfmw0.jpg")
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Bild aus Userform in bestimmte Zeile einfügen

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

326 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bild aus Userform in bestimmte Zeile einfügen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

326 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread