Microsoft Excel

Herbers Excel/VBA-Archiv

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

Grafik exportieren

    Betrifft: Grafik exportieren von: Frederik Fuhrmann
    Geschrieben am: 29.08.2003 11:26:36

    Hallo!

    Wenn ich mit folgendem Ansatz versuche, via sendkeys "Strg + V" einen als Bitmap kopierten Zellbereich einzufügen, geht das nicht - was mache ich falsch?

    Gruß
    F.

      


    Betrifft: ...der Ansatz noch! von: Frederik Fuhrmann
    Geschrieben am: 29.08.2003 11:28:43

    den hatte ich vergessen:

    Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

    ActiveSheet.OLEObjects.Add(ClassType:="Paint.Picture", Link:=False, _
    DisplayAsIcon:=False).Activate

    Application.SendKeys "^ + v"


    Gruß
    F.


      


    Betrifft: Duck Dich. Hier kommt ein Monstrum von: Andreas Water
    Geschrieben am: 29.08.2003 11:47:30

    Sub SchiessBild2(param1range, param2dateiname, param3sleep)
    '
    ' Macht die eigentliche Arbeit von Bild schiessen aufrufen
    '
    '
    'Application.Goto Reference:=Range(param1range)
    'Selection.CopyPicture appearance:=xlScreen, Format:=xlPicture
    'ActiveSheet.Pictures.Paste.Select
    '
    '
    '
        Dim leftp1range As String
    '
    On Error Resume Next
    Kill ("Ausgabe.gif")
    On Error GoTo 0
    
    ' Macro to save a range as a gif-file
    ' using the capability of Excel to do so for charts.
    ' Norbert Koehler 1999-08-26
        Dim objCurrentShape As Object
        Dim strCurrentSheet As String
        Dim strGIFname As String
        Dim strTempShape As String
        Dim intExistingCharts As Integer
        Dim intI As Integer
        Dim intShapeHeight As Integer
        Dim intShapeWidth As Integer
        Range("A1").Select
        strCurrentSheet = ActiveSheet.Name
        Selection.CurrentRegion.Select
    '
            Selection.Range(param1range).Select
    '
        Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        Selection.SpecialCells(xlCellTypeLastCell).Select
        Selection.Offset(1, 1).Select
        ActiveSheet.PasteSpecial Format:="Picture (Enhanced Metafile)", Link:=False, DisplayAsIcon:=False
        strTempShape = Selection.Name
        intExistingCharts = ActiveSheet.ChartObjects.Count
        'MsgBox "Nos of existing Charts " & intExistingCharts
        'For intI = 1 To ActiveSheet.Shapes.Count Step 1
        For intI = ActiveSheet.Shapes.Count To ActiveSheet.Shapes.Count Step 1
            'MsgBox ActiveSheet.Shapes.Count & " shape(s) " & ActiveSheet.Shapes(intI).Type
            ActiveSheet.Shapes(intI).Select
            If ActiveSheet.Shapes(intI).Type = msoPicture Then
                intShapeHeight = ActiveSheet.Shapes(intI).Height
                intShapeWidth = ActiveSheet.Shapes(intI).Width
                'MsgBox "Height " & intShapeHeight & " Width " & intShapeWidth
                'strGIFname = ThisWorkbook.Path & "\" & ThisWorkbook.Name & Selection.Name & ".gif"
                'strGIFname = ThisWorkbook.Path & "\Excel " & Selection.Name & ".gif"
                strGIFname = "Ausgabe.gif"
                Charts.Add
                ActiveChart.ChartType = xlXYScatter
                ActiveChart.Location Where:=xlLocationAsObject, Name:=strCurrentSheet
                ActiveChart.HasLegend = False
                ActiveWindow.Visible = False
                ActiveSheet.ChartObjects(intExistingCharts + 1).Left = 0
                ActiveSheet.ChartObjects(intExistingCharts + 1).Top = 0
                ActiveSheet.ChartObjects(intExistingCharts + 1).Height = intShapeHeight + 8
                ActiveSheet.ChartObjects(intExistingCharts + 1).Width = intShapeWidth + 8
                ActiveSheet.Shapes(intI).Copy
                ActiveSheet.ChartObjects(intExistingCharts + 1).Activate
                ActiveChart.ChartArea.Select
                
                With Selection.Border
                    .Weight = 2
                    .LineStyle = 0
                End With
                
                ActiveChart.Paste
                Application.CutCopyMode = False
                Set objCurrentShape = ActiveSheet.ChartObjects(intExistingCharts + 1).Chart
                objCurrentShape.Export Filename:=strGIFname, FilterName:="GIF"
                ActiveSheet.ChartObjects(intExistingCharts + 1).Delete
            End If
        Next intI
    '
    '
    '
        On Error Resume Next
        ActiveSheet.Shapes(strTempShape).Delete
        On Error GoTo 0
    '
    '
        'Range("A1").Select
    
    '
    '   Erster Versuch - .GIF Datei ist zu gross
    '
    '        Range(param1range).Select
    '        Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    '        Dim cht As Chart
    '        Set cht = Charts.Add
    '        With cht
    '            On Error Resume Next
    '            .Axes(xlValue).MajorGridlines.Delete
    '            .Axes(xlValue).Delete
    '            .PlotArea.ClearFormats
    '            .Axes(xlCategory).Delete
    '            .Legend.Delete
    '            .ChartTitle.Delete
    '            .ChartArea.Clear
    '            .Paste
    '            On Error GoTo 0
    '        End With
    '        cht.Export "Ausgabe.gif"
    '        Application.DisplayAlerts = False
    '        cht.Delete
    '        Application.DisplayAlerts = True
    '
    '
    
    On Error Resume Next
    Kill (param2dateiname & ".gif")
    On Error GoTo 0
    On Error Resume Next
    Name "Ausgabe.gif" As LCase(param2dateiname) & ".gif"
    On Error GoTo 0
    ' Und zum Schluss selektieren wir nur ein Feld in dem Blatt.
    leftp1range = Left(param1range, InStr(1, param1range, ":", vbTextCompare) - 1)
    Range(leftp1range).Select
    '
    End Sub
    



      


    Betrifft: AW: Duck Dich. Hier kommt ein Monstrum von: Frederik Fuhrmann
    Geschrieben am: 29.08.2003 11:52:09

    Hallo!

    Danke für deine Mühe, aber ich will ja unbedingt ein *.bmp haben, mit einem GIF würde ich ja klarkommen!

    Gruß
    F.


      


    Betrifft: AW: Duck Dich. Hier kommt ein Monstrum von: Andreas Walter
    Geschrieben am: 29.08.2003 11:55:56

    1) ersetz mal GIF überall durch BMP uns schau ob es funktioniert

    2) warum unbedingt BMP?


      


    Betrifft: AW: Duck Dich. Hier kommt ein Monstrum von: Frederik Fuhrmann
    Geschrieben am: 29.08.2003 11:58:13

    Hallo!

    Hatte ich schon vorher versucht, geht nicht, dann kommt ein Laufzeitfehler.
    Ich brauche unbedingt ein bmp, weil ich in SAP in einen Langtext ein Bild einbinden möchte, dazu brauche ich ein bitmap!

    Gruß
    F.


      


    Betrifft: AW: Grafik exportieren von: sergiesam
    Geschrieben am: 29.08.2003 11:28:52

    Hi,

    versuchs damit: Sendkeys "^v", True

    aber vorsicht mit sendkeys, dieser Befehl sollte nur als letzte alternative eingesetzt werden.
    Sam


      


    Betrifft: AW: Grafik exportieren von: Frederik Fuhrmann
    Geschrieben am: 29.08.2003 11:31:40

    Hallo Sam!

    ne, geht net

    Gruß
    F.


     

    Beiträge aus den Excel-Beispielen zum Thema " Grafik exportieren"