Range van een werkblad opslaan als afbeelding

[Sanders69]

Wie heeft eerder een range binnen een werkblad opgeslagen als een afbeelding bijv een .png?
Ik heb online wat gezien maar daar maken ze een chart echter maak ik zelf een grafiek dus wil alleen het gebied van de grafiek selecteren en opslaan als.
Hopelijk heeft iemand dit al gedaan.

 

[AHulpje]

Zoiets, nog wel even aanpassen aan je eigen situatie:

Sub ExportAsPNG()
    Dim shp As Shape
    Dim cho As ChartObject
    
    Range("A1:F7").CopyPicture
    ActiveSheet.Paste Cells(10, 14)
    Set shp = Selection.ShapeRange(1)
    Set cho = ActiveSheet.ChartObjects.Add(Left:=shp.Left, Top:=shp.Top, Width:=shp.Width, Height:=shp.Height)
    shp.Copy
    cho.Select
    ActiveChart.Paste
    ActiveChart.Export Filename:=ActiveWorkbook.Path & "\grafiekrange.png", FilterName:="PNG"
    cho.Delete
End Sub

 

[Sanders69]

Het werkt!
Mijn dank is groot!

 

[HSV]

Iets minder handelingen.

Sub hsv()
Dim c As Range
Set c = Range("a1:f7")
 c.CopyPicture
   With ChartObjects.Add(0, 0, c.Width, c.Height).Chart
    .Paste
    .Export ThisWorkbook.Path & "\grafiekrange.png", "png"
    .Parent.Delete
   End With
End Sub

 

[Sanders69]

Ik heb de syntaxis in MS Access geplaatst om de range op te slaan als afbeelding maar dit loopt vast op coderegel: ws.Application.ActiveSheet.Paste Cells(11, 1)
Ik heb de MS Access applicatie als rar bestand meegestuurd wellicht zie jullie wat er kennelijk verkeerd gaat en aangepast moet worden.
Denk dat deze applicatie ook voor anderen dan handig kan zijn.

Dim appExcel
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim shp As Excel.Shape
Dim cho As Excel.ChartObject
    
    On Error GoTo Knop0_Click_Err
    
    Set appExcel = CreateObject("excel.Application")
    Set wb = appExcel.Workbooks.Add
    Set ws = wb.Worksheets(1)
        
    For i = 1 To 10
        For j = 1 To 10
            ws.Application.Cells(i, j) = i * j
        Next j
    Next i
    
    ws.Application.Range("A1:J10").CopyPicture
    ws.Application.ActiveSheet.Paste Cells(11, 1)
    Set shp = ws.Application.Selection.ShapeRange(1)
    Set cho = ws.Application.ActiveSheet.ChartObjects.Add(Left:=shp.Left, Top:=shp.Top, Width:=shp.Width, Height:=shp.Height)
    shp.Copy
    cho.Select
    ws.Application.ActiveChart.Paste
    ws.Application.ActiveChart.Export FileName:=CurDir$ & "\grafiekrange.png", FilterName:="PNG"
    cho.Delete

Knop0_Click_Err:
If Err.Number <> 0 Then
    MsgBox Err.Description, vbCritical + vbOKOnly, Err.Number
End If

 

[AHulpje]

Zo:

    ws.Application.ActiveSheet.Paste ws.Cells(11, 1)

 

[Sanders69]

grrrr helemaal overheen gekeken.
Veel dank!!!!!!

 

[Sanders69]

Btw ik had laatst ook een range geprobeerd via Access als afbeelding te laten maken echter kreeg ik een melding te zien terwijl het wel goed was gegaan.
Ik heb echt gezocht wat er fout ging echter de dagen ervoor kreeg ik de melding niet te zien.
Ik heb de melding in de bijlage geplaatst en hoe kan je zo'n melding uitschakelen want alles ging gewoon goed en nu blijft Access hangen.

 

[AHulpje]

Access en Excel werken asynchroon, Access wacht dus niet tot Excel klaar is met het uitvoeren van opdrachten die vanuit Access gegeven zijn. Daarom kan het nodig zijn op op de juiste plaats(en), en dat is een kwestie van uitproberen, een Sleep commando in te voegen in de Access code.

 

[Sanders69]

Ik zal dit morgen ergens doen. Ik moet nu weg want speel de herfstcompetitie (tennis).
Jij een fijne zaterdag!

 

[snb]

5 overbodige Objectvariabelen in 1 macro.
De grootste verbetering in VBA is With ... End With.
Gebruik VBA voor dit soort klussen.

Sub M_snb()
  With CreateObject("excel.Application").Workbooks.Add.Sheets(1)
    .Range("A1:J10").CopyPicture
    With .ChartObjects.Add(1, 1, .Range("A1:J10").Width, .Range("A1:J10").Height).Chart
      .Paste
      .Export CurDir & "\grafiekrange.png", "PNG"
      .Parent.Delete
    End With
  End With
End Sub

 

[HSV]

En i.p.v. de lus.....

For i = 1 To 10
        For j = 1 To 10
            ws.Application.Cells(i, j) = i * j
        Next j
    Next i

...kun je dit ook gebruiken.

range("a1:j10") = [row(a1:a10)*column(a1:j1)]