Bild speichern

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Bild speichern

17.11.2005 06:40:39

Sebastian

AW: Bild speichern

17.11.2005 12:49:55

Beate

AW: Bild speichern

17.11.2005 16:35:16

Nepumuk

Hallo Beate,
ist doch ganz einfach:

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

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
Public Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function OpenClipboard Lib "user32.dll" ( _
    ByVal hwnd As Long) As Long
Private Declare Function SetClipboardData Lib "user32.dll" ( _
    ByVal wFormat As Long, _
    ByVal hMem As Long) As Long

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

Public Sub test()
    Dim lngTempPicture As Long
    Dim objShape As Shape, objChartObject As ChartObject
    If Not UserForm1.Picture Is Nothing Then 'Namen des Userforms anpassen !!!
        lngTempPicture = CopyImage(UserForm1.Picture.handle, _
            IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
        If lngTempPicture <> 0 Then
            Application.ScreenUpdating = False
            OpenClipboard FindWindow(GC_CLASSNAMEMSEXCEL, Application.Caption)
            EmptyClipboard
            SetClipboardData CF_BITMAP, lngTempPicture
            CloseClipboard
            With ThisWorkbook
                Worksheets.Add
                ActiveSheet.Name = "Temp"
                With Worksheets("Temp")
                    .Paste
                    Set objShape = .Shapes(1)
                    Set objChartObject = .ChartObjects.Add(0, 0, _
                        objShape.Width, objShape.Height)
                    With objChartObject
                        .Activate
                        .Chart.Paste
                        .Chart.Export Filename:=ThisWorkbook.Path & "\Bild.jpg", _
                            FilterName:="JPG", Interactive:=False 'Pfad und Name anpassen !!!
                    End With
                    Set objChartObject = Nothing
                    Set objShape = Nothing
                End With
                With Application
                    .DisplayAlerts = False
                    Worksheets("Temp").Delete
                    .DisplayAlerts = True
                    .ScreenUpdating = True
                End With
            End With
        End If
    End If
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bild speichern

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread