☰

Excel 2007 VBA 将范围导出为 jpg 文件正在截断图片

tag-icon • tag-icon microsoft-excel microsoft-excel-2007 vba charts
Excel 2007 VBA 将范围导出为 jpg 文件正在截断图片

我有一个工作簿，其中包含许多不同范围的数据，有 77 行或更多。我需要复制它们并保存为 JPG 文件，以供其他应用程序使用。

下面是我为此使用的代码示例。它对于最多 68 行的范围工作正常，但对于超过该范围的范围，文件显示的范围高度最多为 1360 像素，其余部分（底部）为白色。

Sub Create_jpg()
Dim MyPath As String
Dim rgExp As Range

    MyPath = ThisWorkbook.Path & "\ScorecardJPEGs\"

    Sheets("LocalMetrics").Select

    Set rgExp = Range("A1:AL77")

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

    With ActiveSheet.ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _
                                      Width:=(rgExp.Width - 10), Height:=(rgExp.Height - 5))
        .Name = "ChartTempEXPORT"
        .Activate
    End With

    ActiveChart.Paste
    ActiveSheet.ChartObjects("ChartTempEXPORT").Chart.Export FileName:=MyPath & "Scorecard.jpg", _
                                                             Filtername:="jpg"
    ActiveSheet.ChartObjects("ChartTempEXPORT").Delete

End Sub

我确认图表的创建和粘贴看起来没问题，因为我删除了最后删除图表的代码行，显然图表上的图片没问题。但是当创建文件时，图片的底部消失了，那里有一个空白。这发生在所有有多行的范围上。

答案1

据我所知，您的粘贴范围大于粘贴空间。我无法让 Excel 获得您描述的空白空间，但以下代码使宏可以处理超过 77 行。

Sub Create_jpg()
Const fColumn As String = "A": Const lColumn As String = "AL"
Const maxRange As Integer = 77
Dim tempRowEnd As Integer: tempRowEnd = 0: Dim tempRowBegin As Integer: tempRowBegin = 0
Dim loopCount As Integer: loopCount = 0
Dim MyPath As String
Dim rgExp As Range
Dim lRowCount As Long:
MyPath = ThisWorkbook.Path & "\ScorecardJPEGs\"
Sheets("Sheet1").Select
lRowCount = Worksheets("Sheet1").UsedRange.Rows.Count
Do
    tempRowBegin = tempRowEnd + 1 'chooses the first row in the selection
    tempRowEnd = tempRowEnd + maxRange 'chooses the end row in the selection
    Set rgExp = Range(fColumn & tempRowBegin & ":" & lColumn & tempRowEnd)

    rgExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    With ActiveSheet.ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _
                                  Width:=(rgExp.Width - 10), Height:=(rgExp.Height - 5))
        .Name = "ChartTempEXPORT"
        .Activate
    End With

    ActiveChart.Paste
    ActiveSheet.ChartObjects("ChartTempEXPORT").Chart.Export Filename:=MyPath & "Scorecard" & loopCount & ".jpg", _
                                                     Filtername:="jpg"
    ActiveSheet.ChartObjects("ChartTempEXPORT").Delete

    loopCount = loopCount + 1 'increments count for naming convention
Loop Until tempRowEnd > lRowCount

End Sub

请让我知道这对您有何帮助。

相关内容