Excel VBA lưu ảnh chụp màn hình

Question

tôi cố gắng để có một ảnh chụp màn hình của một Worksheet trong Excel với mã VBA và sau đó lưu nó trong một đường dẫn nhất định, nhưng tôi không quản lý để tiết kiệm nó đúng ...

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 không muốn thực thi phương thức .Export ... ngay sau khi chụp ảnh màn hình. Vì vậy, tôi đã cố gắng dán hình ảnh vào biểu đồ mới. Excel lưu các hình ảnh biểu đồ ở đúng nơi với một biểu đồ trên hình ảnh của tôi ... Tôi cũng đã cố gắng để dán nó vào một bảng tạm thời nhưng Excel không muốn xuất nó ...

Bất kỳ ý tưởng

Answer 1

Đã bận rộn với ý tưởng mà Luboš Suk có.

Chỉ cần thay đổi kích thước của Biểu đồ. Xem tập lệnh bên dưới.

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 

Answer 2

Tôi đã làm một cái gì đó tương tự như tháng trước. Tôi cần tạo một ảnh chụp màn hình của phạm vi cụ thể và xuất nó vào tệp. Sau nhiều giờ đột nhập vào bảng tôi tìm thấy giải pháp với .chart.export mà dường như hầu hết người dùng thân thiện với tôi. Xin hãy xem mã của tôi, tôi nghĩ bạn có thể dễ dàng cập nhật nó theo nhu cầu của bạn. Suy nghĩ đơn giản là tạo biểu đồ, dán bất kỳ thứ gì bạn muốn chụp ảnh màn hình trong đó, xuất biểu đồ thành ảnh và sau đó xóa id. Đơn giản và thanh lịch. Vui lòng hỏi xem có vấn đề gì không

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 

Theo nhận xét của bạn, tôi nghĩ bạn có thể tính kích thước biểu đồ từ kích thước hàng/cột và số lượng của chúng. Hoặc bạn có thể thay đổi kích thước biểu đồ bằng cách sử dụng các thuộc tính vị trí và kích thước của ô. (look for .cells().width, .cells().height,.cells().top, .cells().left)