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.