Cách sao chép và dán dải ô tính Excel vào nhiều trang trình chiếu Powerpoint khác nhau bằng VBA

Trong bài viết này, Học Excel Online sẽ hướng dẫn bạn cách sao chép và dán dải ô tính Excel vào nhiều trang trình chiếu Powerpoint khác nhau bằng VBA. Dưới đây là ví dụ minh họa:

Đoạn mã lệnh VBA được sử dụng sẽ có dạng như sau:

Sub PasteMultipleSlides()

Dim myPresentation As Object
Dim mySlide As Object
Dim PowerPointApp As Object
Dim shp As Object
Dim MySlideArray As Variant
Dim MyRangeArray As Variant
Dim x As Long

‘Create an Instance of PowerPoint
  On Error Resume Next
    
    ‘Is PowerPoint already opened?
      Set PowerPointApp = GetObject(class:=”PowerPoint.Application”)
    
    ‘Clear the error between errors
      Err.Clear

    ‘If PowerPoint is not already open then Exit
      If PowerPointApp Is Nothing Then
        MsgBox “PowerPoint Presentation is not open, aborting.”
        Exit Sub
      End If
    
    ‘Handle if the PowerPoint Application is not found
      If Err.Number = 429 Then
        MsgBox “PowerPoint could not be found, aborting.”
        Exit Sub
      End If

  On Error GoTo 0
  
‘Make PowerPoint Visible and Active
  PowerPointApp.ActiveWindow.Panes(2).Activate
    
‘Create a New Presentation
  Set myPresentation = PowerPointApp.ActivePresentation

‘List of PPT Slides to Paste to
  MySlideArray = Array(2, 3, 4, 5, 6)

‘List of Excel Ranges to Copy from
    MyRangeArray = Array(Sheet1.Range(“A1:C10”), Sheet4.Range(“A1:C10”), _
      Sheet3.Range(“A1:C10”), Sheet2.Range(“A1:C10”), Sheet5.Range(“A1:C10”))

‘Loop through Array data
  For x = LBound(MySlideArray) To UBound(MySlideArray)
    ‘Copy Excel Range
        MyRangeArray(x).Copy
    
    ‘Paste to PowerPoint and position
      On Error Resume Next
        Set shp = myPresentation.Slides(MySlideArray(x)).Shapes.PasteSpecial(DataType:=2) ‘Excel 2007-2010
        Set shp = PowerPointApp.ActiveWindow.Selection.ShapeRange ‘Excel 2013
      On Error GoTo 0
    
    ‘Center Object
      With myPresentation.PageSetup
        shp.Left = (.SlideWidth \ 2) – (shp.Width \ 2)
        shp.Top = (.SlideHeight \ 2) – (shp.Height \ 2)
      End With
      
  Next x

‘Transfer Complete
  Application.CutCopyMode = False
  ThisWorkbook.Activate
  MsgBox “Complete!”

End Sub

Tận dụng lợi thế của tập hợp

‘List of PPT Slides to Paste to
  MySlideArray = Array(2, 3, 4, 5, 6)

‘List of Excel Ranges to Copy from
    MyRangeArray = Array(Sheet1.Range(“A1:C10”), Sheet4.Range(“A1:C10”), _
      Sheet3.Range(“A1:C10”), Sheet2.Range(“A1:C10”), Sheet5.Range(“A1:C10”))

Các tập hợp một chiều được sử dụng dưới dạng các danh sách và có tác dụng rất tốt trong việc tự động hóa tác vụ đơn giản như sao chép và cắt dán dữ liệu. Trong mã lệnh trên bạn có thể thấy có 2 tập hợp. Một cái sử dụng để lữu trữ nội dung dải ô Excel mà bạn muốn sao chép, cái còn lại sẽ lưu trữ trang trình chiếu Powerpoint mà bạn muốn dán nội dung vào. Khi hai tập hợp này trùng nhau (tức là toàn bộ phần tử của tập hợp này đều thuộc tập hợp kia), quá trình thiết lập sẽ tự động được kích hoạt. Như trên ví dụ mã lệnh trên, ta đang sử dụng nhiều ô tính được tham chiếu từ nhiều bảng tính khác nhau. Bạn cũng có thể áp dụng tương tự hoặc thậm chí là thử tham chiếu dữ liệu từ các trang tính Excel khác nữa.

Lọc quay vòng nội dung của tập hợp

‘Loop through Array data
  For x = LBound(MySlideArray) To UBound(MySlideArray)
    ‘Copy Excel Range
        MyRangeArray(x).Copy
    
    ‘Paste to PowerPoint and position
      On Error Resume Next
        Set shp = myPresentation.Slides(MySlideArray(x)).Shapes.PasteSpecial(DataType:=2) ‘Excel 07-10
        Set shp = PowerPointApp.ActiveWindow.Selection.ShapeRange ‘Excel 2013
      On Error GoTo 0
   
   Next x

Phần mã lệnh trên cho phép bạn có thể quay vòng và lọc các dữ liệu có trong tập hợp. Bằng cách tận dụng các hàm chức năng LBound (Chặn dưới) và UBound (Chặn trên), bạn có thể an tâm rằng quy trình lọc dữ liệu quay vòng này sẽ chạy đủ số lượt. Nếu bạn muốn tăng và giảm số lượng tập hợp trong danh sách (do lượng dữ liệu cần sao chép có sự thay đổi), bạn không cần phải thay đổi nội dung đoạn mã trên vì chúng được cấu tạo ở trạng thái động!

Lưu ý: Trong quá trình thiết lập biến shp để lưu trữ hình ảnh được sao chép, bạn sẽ gặp phải một số thông báo lỗi. Với Office phiên bản 2007 và 2010, bạn vẫn có thể thiết lập biến trong cùng một hàng với lệnh PasteSpecial. Tuy vậy, lỗi sẽ xảy ra đối với Office phiên bản 2013. Ngược lại, trong phiên bản 2013 bạn có thể dễ dàng thiết lập biến ShapeRange đại diện cho hình vẽ được lựa chọn (tức là nó sẽ tự động lựa chọn hình vẽ mới được sao chép xong), còn trong phiên bản 2007/2010 sẽ không hoạt động được. Lời khuyên là bạn hãy cứ chạy cả 2 lệnh cùng lúc và bỏ qua bất cứ thông báo lỗi nào xuất hiện.

Căn chỉnh hình ảnh minh họa vào giữa khung trình chiếu

‘Set variable equal to newly pasted shape
      Set shp = PowerPointApp.ActiveWindow.Selection.ShapeRange
    
    ‘Center Object
      With myPresentation.PageSetup
        shp.Left = (.SlideWidth \ 2) – (shp.Width \ 2)
        shp.Top = (.SlideHeight \ 2) – (shp.Height \ 2)
      End With

Các công thức tính trong lệnh trên xuất phát từ chiều dài và chiều rộng của bức ảnh được dùng làm hình minh họa cũng như của kích cỡ của khung trình chiếu với mục đích đi tìm được điểm trung tâm của khung hình. Bạn cũng có thể đặt ảnh vào một vị trí khác nếu muốn bằng cách thay đổi các thông số mặc định như Left, Top, Height, và Width. Sử dụng lệnh VBA để tìm ra kích cỡ các chiều của bức ảnh. Lưu ý bạn phải mở khóa tỉ lệ khung ảnh trước khi thay đổi kích cỡ ảnh mà ý mình muốn.