Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Bild aus Userform in bestimmte Zeile einfügen
David
Moin Moin,
ich komme mal wieder nicht weiter... :-(
Vor kurzer Zeit habe ich das Problem gehabt, dass ich gerne Bilder in einer Userform anzeigen lassen wollte.
Nun soll im nächsten Schritt dieses Bild, welches mir in einem Image in der Userform angezeigt wird auch gleichzeitig in Tabelle 6 in C20 eingefügt und am besten zentriert werden.
Es werden in 2 Images je ein Bild angezeigt.
Hier der aktuelle Code für das Einfügen der Bilder in die Userform:
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
Könnt ihr mir weiterhelfen?
Danke schon mal für eure Unterstützung.
Gruß
David

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

Betreff
Benutzer
Anzeige
AW: Bild aus Userform in bestimmte Zeile einfügen
07.06.2011 09:45:23
Rudi
Hallo,
als Ansatz:
.......
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
......

Gruß
Rudi
Code von Nepumuk
07.06.2011 09:45:53
Nepumuk
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
Anzeige
AW: Code von Nepumuk
10.06.2011 07:20:14
Nepumuk
Hallo Nepumuk,
leider kann ich deine Beispielmappe auch nicht zum laufen bekommmen. Er bleibt beim selben Code stehen.
Call OpenClipboard(Application.hwnd).
Woran liegt es? Hast du eine Idee.
Zur Zeit muss ich Excel 2000 benutzen, liegt es daran?
Danke für deine Hilfe
Gruß
David
AW: Code von Nepumuk
10.06.2011 20:48:10
Nepumuk
Hallo daniel,
ich sag mal ja, mein XL 2000 kennt kein Application.hwnd, mein XL 2007 aber durchaus.
Gruß
Reinhard
Anzeige
AW: Code von Nepumuk
11.06.2011 07:48:03
Nepumuk
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
Anzeige

350 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige