Single VBA code for multiple worksheet

charlienguyen

New Member
Joined
Mar 5, 2020
Messages
2
Office Version
  1. 365
Platform
  1. Windows
Hi VBA experts,

I'm Charlie and I just recently work with VBA.
At the moment I have a task where I need to transfer multiple data tables from Excel to Powerpoint.
I searched through many sites but the answers are quite fragmented so I will state what I'm confusing here:
- If each worksheet contains 1 table and I want to copy each of it to a specific slide in Powerpoint, what's the phrase?
- Does loop function work if my data tables are not in the same position?
- After finishing a sheet, how do you move on to another sheet (by activating it)?
In the end, the structure of the code that I imagine will be: Open a selected PPT slide, select data from sheet 1 & copy it to slide 3 in PPT (then align its picture), move on to sheet 2 & copy its data to slide 4, sheet 3 - slide 6, sheet 4 - slide 7, sheet 5 - slide 9, and so on...

Below is what I did as copying each table to a slide. I have about +20 modules like this so it would be extremely convenient if Excel can run all of them just by single module.
Again thanks for the help from everyone.

VBA Code:
Sub TCHSlide1()

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim rng As Range

'Check Range
Range("B4:K18").Select

'Check source open
On Error Resume Next
    Set PPApp = GetObject(, "Powerpoint.Application")
        On Error GoTo 0
    If PPApp Is Nothing Then
        Set PPApp = CreateObject("Powerpoint.Application")
        PPApp.Visible = msoCTrue
        Set PPPres = PPApp.Presentations.Open("C:\Users\huhiuhi\Downloads\Telegram Desktop\Monthly report - final table picture.pptx")
    Else
        Set PPPres = PPApp.ActivePresentation
    End If
  Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
  
    Selection.CopyPicture Appearance:=xlScreen, _
        Format:=xlPicture

    PPSlide.Shapes.Paste.Select
  
    PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
    PPApp.ActiveWindow.Selection.ShapeRange.Left = 15.5
    PPApp.ActiveWindow.Selection.ShapeRange.Top = 62.5
    
With PPSlide.Shapes(PPSlide.Shapes.Count)
    .Width = 932
    If .Width > 932 Then .Width = 932
End With

'1 inch = 72.46, left & top là align

    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set PPApp = Nothing


End Sub
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college

Forum statistics

Threads
1,215,034
Messages
6,122,782
Members
449,095
Latest member
m_smith_solihull

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top