Question

我们已经创建了一个电子表格，其中单元格的颜色等是基于外部源的状态（使用RSLinx的PLC标签）的条件。我们编写了一个宏来拍摄特定范围的屏幕截图并将其另存为JPG。然后，我们创建了一个网站，用于显示电子表格的图像，该图像将每30秒更新一次，以便提供“直播”电子表格。代表什么是正在进行的。宏如下所示：

Option Explicit

Private Sub SaveRngAsJPG(Rng As Range, FileName As String)
Dim Cht As Chart, bScreen As Boolean, Shp As Shape
bScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
Set Cht = Workbooks.Add(xlChart).Charts(1)
Cht.ChartArea.Clear
Rng.CopyPicture xlScreen, xlPicture
Cht.Paste
With Cht.Shapes(1)
    .Left = 0
    .Top = 0
    .Width = Cht.ChartArea.Width
    .Height = Cht.ChartArea.Height
End With


Cht.Export FileName, "PNG", False
Cht.Parent.Close False
Application.ScreenUpdating = bScreen
End Sub

Sub TestIt2()
Dim Rng As Range, Fn As String
Set Rng = Range("A3:AQ40")
Fn = "C:\Users\Desktop\Website\LHImage.png"
SaveRngAsJPG Rng, Fn
End Sub

我们遇到的问题是图像以981x659的尺寸保存。这会扭曲图像，当我尝试改变.width和.height线条的大小时，它会调整图像主体的大小，但会在其周围留下980x659的完整大小。

在保存之前，我有什么方法可以改变图像的大小以保持其宽高比？

非常感谢任何帮助！

Answer 1

此方法会像您一样创建一个图表，并将您想要的范围粘贴到图表中。在chtemp.parent中使用循环，更改尺寸以适合图片的大小。可能需要一些玩耍。

dim rng as range
dim chtemp as chart
Set rng = Range("A3:AQ40")
rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
'--------------------------------------------------------- 
Charts.add

'Creates a chart where the final picture will be moved on for picture export
'-----------------------------------------------------------------
ActiveChart.Location WHere:=xlLocationAsObject, Name:='Current worksheet'.Name
    Set chtemp = ActiveChart
    With chtemp.Parent
        .Top = [Y1].Top
        .Left = [Y1].Left
        .Width = [Y10:AU55].Width
        .height = [Y10:AU55].height
    End With

rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    chtemp.Paste
    chtemp.Export Filename:='filename, FilterName:="png"
    Application.DisplayAlerts = False

Excel宏截图

1 个答案: