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.

Tác giả: dtnguyen (Nguyễn Đức Thanh)

@ Học Excel Online | DTNguyen.business
· · ·

Khóa học mới xuất bản

© Học Excel Online. All rights reserved.