Bild speichern

Forumthread: Bild speichern

Bild speichern

17.11.2005 02:08:16

Beate

Hallo,
ich habe in einer Userform als Hintergrund mal ein Bild geladen. Das Bild ist
ist als Datei auf dem Rechner nicht mehr vorhanden. Kann ich das Bild aus der Userform wieder zurück speichern in eine Datei? Ist echt wichtig, weil das
Bild auch in Word gebraucht wird. Wer hilft mir?
Grüße Beate

3
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

AW: Bild speichern

17.11.2005 06:40:39

Sebastian

Hi,
Du musst einfach in deine schon vorhandene Userform gehen, und das Eigenschaftenfenster anzeigen lassen, mit dem du das Bild in den Hintergrund geladen hast. Die Eigenschaft heißt Picture. Wenn du nun den Inhalt markierst und mit "Strg C" kopierst. Dann ein neues Bild mit Paint erstellst und in Paint das Bild einfügst kannst du es speichern. Also:
1. Makro Editor öffnen
2. Aktuelle Userform anklicken
3. unter Ansicht Eigenschaftenfenster anklicken
4. Im Eigenschaftenfenster den Wert hinter Picture markieren und kopieren. z.b. (Bitmap)
5. Paint öffnen
6. Bearbeiten Einfügen klicken
7. Speichern!!
So einfach ist das!

AW: Bild speichern

17.11.2005 12:49:55

Beate

Hallo,
danke für den Tipp, ich hätte gleich schreiben sollen, dass eine automatische Lösung
mit makro gesucht ist.
Grüße 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)

Forumthread: Bild speichern

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread