Ряд экспорта Excel 2007 VBA как архив jpg trucating изображение

У меня есть книга со многими различными диапазонами данных с 77 строками или более. Мне нужно скопировать их и сохранить как файлы JPG, которые будут использоваться другим приложением.

Ниже приведен пример кода, который я использую для этого. Он отлично работает для диапазонов до 68 строк, но для диапазонов с более чем этим файл показывает высоту около 1360 пикселей диапазона, а остальная его часть (нижняя часть) белая.

Sub Create_jpg()
Dim MyPath Как Строка
Дим аргумента rgexp в качестве Диапазон

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

Конец Sub

Я проверил, что создание диаграммы и вставьте выглядит нормально, как я удалил код, который удаляет таблицу в конце и, видимо, картину на графике было ок. Но когда файл создается, нижняя часть картинки просто исчезает, и появляется пустое место.
Это произошло со всеми диапазонами со многими строками.

24
задан Reinaldo
17.12.2022 22:09 Количество просмотров материала 2666
Распечатать страницу

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

Дайте мне знать, как это работает для вас.

0
отвечен slow_excellence 2022-12-19 05:57

Постоянная ссылка на данную страницу: [ Скопировать ссылку | Сгенерировать QR-код ]

Ваш ответ

Опубликуйте как Гость или авторизуйтесь

Имя
Вверх