Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema Frame
BildScreenshot zu Frame Frame-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Image
BildScreenshot zu Image Image-Seite mit Beispielarbeitsmappe aufrufen

copypicture | Herbers Excel-Forum


Betrifft: copypicture von: Sivis
Geschrieben am: 27.01.2012 12:24:58

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

  

Betrifft: AW: copypicture von: Josef Ehrensberger
Geschrieben am: 27.01.2012 12:31:31


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 »



  

Betrifft: AW: copypicture von: Sivis
Geschrieben am: 27.01.2012 14:25:54

Lieber Sepp,


zunächst mal vielen herzlichen Dank für Deine schnelle Antwort...! Ich hätte nicht gedacht, dass man es doch so kompliziert lösen muss, ich dachte, ich hätte einfach einen .paste/.insert/.pastespecial-befehl falsch verstanden/angewendet...!


Ich habe den code in meinen integriert und laufen gelassen, es funktioniert leider nicht. Ich erhalte die Fehlermeldung "Laufzeitfehler 481. ungültiges Bild". Wenn ich die Dateiendung des strFile in .bmp ändere (die Funktion RangeToImage stellt ja ein Bitmap her), funktioniert zwar der userform-code noch, aber das image imgFrame zeigt nichts an... . Was mache ich falsch...?!?

herzliche Grüsse und vielen Dank jetzt schon mal für Deine Antwort...!!

Mario


  

Betrifft: AW: copypicture von: Josef Ehrensberger
Geschrieben am: 27.01.2012 14:58:50


Hallo Mario,

sorry, ja png geht nicht.

Aber
strFile = Environ("TEMP") & "\tmp.jpg"
und
strFile = Environ("TEMP") & "\tmp.bmp"
funktionieren




« Gruß Sepp »



  

Betrifft: AW: copypicture von: Sivis
Geschrieben am: 27.01.2012 15:10:31

Hi Sepp,

danke für die Antwort. Weisst du, warum mein Image nichts anzeigt...?!?

herzliche Grüsse!


Mario


  

Betrifft: AW: copypicture von: Josef Ehrensberger
Geschrieben am: 27.01.2012 17:07:58


Hallo Mario,

dazu müsste ich deine Datei sehen, oder zumindest den gesamten Code.




« Gruß Sepp »



  

Betrifft: AW: copypicture von: Sivis
Geschrieben am: 30.01.2012 17:06:07

Hallo Sepp!

sorry, dass ich erst jetzt antworte, war im Wochenende... ;-))

ich kann Dir die Datei gerne schicken...! Ist etwas gross und mit Sicherheit unübersichtlich, aber ich bin sowieso froh um JEDEN Tipp oder Hint...

Schick mir deine Email-Adresse (kann man das hier verschlüsselt oder "privat"), dann schicke ich Dir das Ding mit Kommentaren gerne zu...

lieben Gruss!


Mario


  

Betrifft: AW: copypicture von: Josef Ehrensberger
Geschrieben am: 30.01.2012 21:44:30


Hallo Mario,

lade doch ein abgespecktes Beispiel hoch, nur die UF und der dazugehörige Code.




« Gruß Sepp »