微信公众号搜"智元新知"关注
微信扫一扫可直接关注哦!

从 Access 在 Excel 中保存图表图片

如何解决从 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

版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。