从 Access 在 Excel 中保存图表图片

问题描述

我在 Access 中工作。通过单击蒙版中的按钮,我想打开(如果不可见则更好)Excel 文件,更新数据源和图形,将单元格范围内的图形保存到图像中,并在邮件文本中发送此图像.

图像保存 RefreshAll 方法与 range() 方法不同。

Function invia_grafici_accessi()

Dim MyXL As Object
Dim Rng As Object
Dim oChrtO As Object

Set MyXL = CreateObject("Excel.Application")

With MyXL
    .Application.Visible = False
    .Workbooks.Open "\\sdocenco01\OPC\12_SCL_RESPONSABILI_COORDINATORI\ACCESSI_SPORTELLI\grafici.xlsx"
    .Workbooks.Foglio1.RefreshAll
    
    Rng = .Workbooks.Foglio1.Range("AG15:AU116")

    Rng.copyPicture xlScreen,xlPicture
    lWidth = oRng.Width
    lHeight = oRng.Height

    Set oChrtO = oWs.ChartObjects.Add(Left:=0,Top:=0,Width:=lWidth,Height:=lHeight)

    oChrtO.Activate
    With oChrtO.Chart
        .Paste
        .Export FileName:="\myforder\myimage.jpg",Filtername:="JPG"
    End With

    oChrtO.Delete
End With

End Function

解决方法

下面的一些修复/建议更改:

Sub invia_grafici_accessi()
    Dim MyXL As Object,wb As Object,ws As Object
    Dim Rng As Object
    Dim oChrtO As Object

    Set MyXL = CreateObject("Excel.Application")
    MyXL.Visible = False
    'get a reference to the opened workbook
    Set wb = MyXL.Workbooks.Open("\\sdocenco01\OPC\12_SCL_RESPONSABILI_COORDINATORI\ACCESSI_SPORTELLI\grafici.xlsx")
    Set ws = wb.Worksheets(1) 'or whichever worksheet you want
    
    wb.RefreshAll 'make sure your queries are not set to run in the background...
    
    Set Rng = ws.Range("AG15:AU116")
    Rng.CopyPicture xlScreen,xlPicture
    lWidth = Rng.Width
    lHeight = Rng.Height

    Set oChrtO = oWs.ChartObjects.Add(Left:=0,Top:=0,Width:=lWidth,Height:=lHeight)
    oChrtO.Activate
    With oChrtO.Chart
        .Paste
        .Export Filename:="\myfolder\myimage.jpg",Filtername:="JPG"
    End With
    oChrtO.Delete
End Sub