Excel VBA сохранить скриншот

Я пытаюсь сделать скриншот листа в Excel с кодом VBA, а затем сохранить его по указанному пути, но мне не удалось сохранить его должным образом...

Sub My_Macro(Test, Path)
  Dim sSheetName As String
  Dim oRangeToCopy As Range
  Dim FirstCell As Range, LastCell As Range

  Worksheets(Test).Activate
  Set LastCell = Cells(Cells.Find(What:="*", SearchOrder:=xlRows, _
      SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
      Cells.Find(What:="*", SearchOrder:=xlByColumns, _
      SearchDirection:=xlPrevious, LookIn:=xlValues).Column)
  Set FirstCell = Cells(Cells.Find(What:="*", After:=LastCell, SearchOrder:=xlRows, _
      SearchDirection:=xlNext, LookIn:=xlValues).Row, _
      Cells.Find(What:="*", After:=LastCell, SearchOrder:=xlByColumns, _
      SearchDirection:=xlNext, LookIn:=xlValues).Column)

  sSheetName = Test ' worksheet to work on

  With Worksheets(sSheetName)
      .Range(FirstCell, LastCell).CopyPicture xlScreen, xlPicture
      .Export Filename:=Path + Test + ".jpg", Filtername:="JPG"
  End With

End Sub

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

идеи

6
excel excel-vba vba

2 ответов

был занят идеей Любоша сука.

просто измените размер диаграммы. См. сценарий ниже.

Sub My_Macro(Test, Path)


 Test = "UNIT 31"
    Dim sSheetName As String
    Dim oRangeToCopy As Range
    Dim FirstCell As Range, LastCell As Range

    Worksheets(Test).Activate

    Set LastCell = Cells(Cells.Find(What:="*", SearchOrder:=xlRows, _
        SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
        Cells.Find(What:="*", SearchOrder:=xlByColumns, _
        SearchDirection:=xlPrevious, LookIn:=xlValues).Column)

    Set FirstCell = Cells(Cells.Find(What:="*", After:=LastCell, SearchOrder:=xlRows, _
        SearchDirection:=xlNext, LookIn:=xlValues).Row, _
        Cells.Find(What:="*", After:=LastCell, SearchOrder:=xlByColumns, _
        SearchDirection:=xlNext, LookIn:=xlValues).Column)

    sSheetName = Test ' worksheet to work on

    With Worksheets(sSheetName).Range(FirstCell, LastCell)

        .CopyPicture xlScreen, xlPicture
        'Getting the Range height
        PicHeight = .Height
        'Getting the Range Width
        PicWidth = .Width

        ''.Export Filename:=Path + Test + ".jpg", Filtername:="JPG"   'REMOVE THIS LINE


    End With


    With Worksheets(sSheetName)

        'Creating the Chart
        .ChartObjects.Add(30, 44, PicWidth, PicHeight).Name = "TempChart"

        With .ChartObjects("TempChart")

            'Pasting the Image
            .Chart.Paste
            'Exporting the Chart
            .Chart.Export Filename:=Path + Test + ".jpg", Filtername:="JPG"

        End With

        .ChartObjects("TempChart").Delete

    End With

End Sub
5

Я делал что-то подобное несколько месяцев назад. Мне нужно сделать скриншот определенного диапазона и экспортировать его в файл. После нескольких часов головокружения в таблице я нашел решение с .chart.export что кажется мне наиболее удобным для пользователя. Пожалуйста, взгляните на мой код, я думаю, вы можете легко обновить его с вашими потребностями. Простая мысль-создать диаграмму, вставить все, что вы хотите, чтобы сделать снимок экрана, экспортировать диаграмму в изображение, а затем удалить id. Просто и элегантно. Не стесняйтесь спрашивать, есть ли какая-то проблема!--4--> 

Sub takeScreen()
    Dim mainSheet As Worksheet
    Set mainSheet = Sheets("Input-Output")

    Dim path As String
    path = Application.ActiveWorkbook.path

    Application.ScreenUpdating = False


    If Dir(path & "\figures\", vbDirectory) = "" Then
        MsgBox "Directory figures not found. Cannot save image."
        Exit Sub
    End If

    With mainSheet
        .ChartObjects.Add(30, 44, 765, 868).Name = "exportChart"
        With .ChartObjects("exportChart")
            .Chart.ChartArea.Border.LineStyle = xlNone
            .Chart.ChartArea.Fill.Visible = False
            mainSheet.Range(mainSheet.Cells(4, "B"), mainSheet.Cells(60, "L")).CopyPicture
            .Chart.Paste
            .Chart.Export fileName:=path & "\figures\" & "fatigue_summary.png ", FilterName:="png"
        End With
        .ChartObjects("exportChart").Delete
    End With

    Application.ScreenUpdating = True

End Sub

по вашему комментарию, я думаю, вы можете рассчитать размер диаграммы размеры строк и столбцов и их количество. Или вы можете изменить размер диаграммы, используя атрибуты положения и размера ячеек. (look for .cells().width, .cells().height,.cells().top, .cells().left)

2