Excel 2007 VBA intervalo de exportação como arquivo jpg é trucating imagem

Question

Eu tenho uma pasta de trabalho com muitos intervalos diferentes de dados com 77 linhas ou mais. Eu preciso copiá-los e salvá-los como arquivos JPG, que serão usados por outro aplicativo.

Abaixo está o exemplo de código que estou usando para isso. Ele funciona bem para faixas com até 68 linhas, mas para intervalos com mais do que isso, o arquivo mostra até 1360 pixels de altura do intervalo e o restante (a parte inferior) é branco.

Sub Create_jpg () Dim MyPath As String Dim rgExp como intervalo

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

Verifiquei que a criação do gráfico e da colagem parece adequada, pois removi a linha de código que exclui o gráfico no final e, aparentemente, a imagem no gráfico estava ok. Mas quando o arquivo é criado, a parte inferior da imagem simplesmente desaparece e há um espaço em branco. Isso aconteceu com todos os intervalos com muitas linhas.

    

Answer 1

Pelo que posso dizer, seu intervalo de colagem é maior do que o espaço de colagem. Não consegui obter o excel para obter o espaço em branco que você descreveu, mas o código a seguir fez com que a macro pudesse manipular mais de 77 linhas.

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

Deixe-me saber como isso funciona para você.