copypicture

Hallo Liebe Forumler,
ich habe ein kleines Problem, zu dem ich keine Antwort im forum gefunden hab, drum schreibe ich diesen beitrag, ich bin sicher, dass Ihr mir helfen könnt.
Ich möchte per vba einen Bereich einer arbeitsmappe als bild in einem userform einfügen.
Das Kopieren und Einfügen eines Bereiches in ein Worksheet ist kein Problem, der folgende code funktioniert einwandfrei:
Worksheets("mol_weights").Range("E1").CopyPicture xlScreen, xlBitmap
Worksheets("mol_weights").Paste _
Destination:=Worksheets("mol_weights").Range("E6")
auch das herber-beispiel des picture-imports funktioniert:
imgFrame.Picture = LoadPicture(lblDir.Caption & "\" & lblFile.Caption)
Nur weiss ich nicht, wie ich das mit .copypicture kopierte Bild als image in einem userform einfügen kann.
ich hoffe, ich hab mich nicht zu kompliziert ausgedrückt.
jetzt schon mal vielen Dank für Eure Antworten!!
Mario

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Mario,

' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Function RangeToImage(ByVal ImageFile As String, ByRef ImageRange As Object) As Long
  Dim objPict As Object, objChrt As Chart
  Dim strExt As String, bDelPic As Boolean
  
  On Error GoTo ErrExit
  
  RangeToImage = -1
  
  With ImageRange.Parent
    If TypeName(ImageRange) = "Range" Then
      ImageRange.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
      
      .PasteSpecial Format:="Bitmap"
      
      Set objPict = .Shapes(.Shapes.Count)
      bDelPic = True
    ElseIf TypeName(ImageRange) = "Shape" Then
      Set objPict = ImageRange
    End If
    
    objPict.Copy
    
    Set objChrt = .ChartObjects.Add(1, 1, objPict.Width + 8, objPict.Height + 8).Chart
    
    strExt = Mid(ImageFile, InStrRev(ImageFile, ".") + 1)
    
    objChrt.Paste
    objChrt.Export ImageFile, FilterName:=strExt
    objChrt.Parent.Delete
    If bDelPic Then objPict.Delete
    DoEvents
    Set objPict = Nothing
    Set objChrt = Nothing
    RangeToImage = 0
  End With
  
  ErrExit:
  If Not objChrt Is Nothing Then objChrt.Parent.Delete
  If bDelPic Then If Not objPict Is Nothing Then objPict.Delete
  Set objPict = Nothing
  Set objChrt = Nothing
End Function


Sub test()
  Dim lngRet As Long
  Dim strFile As String
  
  strFile = Environ("TEMP") & "\tmp.png"
  
  lngRet = RangeToImage(strFile, Worksheets("mol_weights").Range("E1"))
  
  If lngRet = 0 Then
    imgFrame.Picture = LoadPicture(strFile)
    Kill strFile
  End If
End Sub

« Gruß Sepp »

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

copypicture

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread