Calling modules from main sub

Topic

New Reply

I am trying to create slides and save them as png images with VBA code.
I can run both modules separately without any problems
When I call the modules from the MAIN sub… the result is not the same.
The slides are saved but the text overflows on top of each other without shrinking.

Can someone offer a solution to this problem

Code:

 Sub MAIN()
 Call Module1.CreateSlides
 Call Module2.SaveSlides
 End Sub ---

[Module1]

Code:

 Sub CreateSlides()

 'Open the Excel workbook. Change the filename here.
 Dim OWB As New Excel.Workbook
 Set OWB = Excel.Application.Workbooks.Open("C:BBooksTXT.xlsx")
 'Grab the first Worksheet in the Workbook
 Dim WS As Excel.Worksheet
 Set WS = OWB.Worksheets(1)
 'Loop through each used row in Column A
 For i = 1 To WS.Range("A65536").End(xlUp).Row

     'Copy the first slide and paste at the end of the presentation
     ActivePresentation.Slides(1).Copy
     ActivePresentation.Slides.Paste (ActivePresentation.Slides.Count + 1)

     'Change the text of the first text box on the slide.
     ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(1).TextFr  ame.TextRange.Text = WS.Cells(i, 1).Value
     ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(2).TextFr  ame.TextRange.Text = WS.Cells(i, 2).Value
     ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(3).TextFr  ame.TextRange.Text = WS.Cells(i, 3).Value
  Next

 'Close Excel
 ActiveWorkbook.Close

 'Delete presentation
 ActivePresentation.Slides(1).Delete
 End Sub

[Module2]

Code:

 Sub SaveSlides ()
 'Save slides as png
 Dim sImagePath As String
 Dim sImageName As String
 Dim oSlide As Slide '* Slide Object

 On Error GoTo Err_ImageSave

 sImagePath = "C:"
 For Each oSlide In ActivePresentation.Slides
 sImageName = oSlide.SlideNumber & ".png"
 oSlide.Export sImagePath & sImageName, "PNG"
 Next oSlide

 Err_ImageSave:
 If Err  0 Then
 MsgBox Err.Description
 End If
 'Delete all slides
 Dim Pre As Presentation
 Set Pre = ActivePresentation
 Dim x As Long
 For x = Pre.Slides.Count To 1 Step -1
     Pre.Slides(x).Delete
 Next x
 'Add New slide
 Set pptLayout = ActivePresentation.Designs(1).SlideMaster.CustomLayouts(1)
 Set Sld = ActivePresentation.Slides.AddSlide(1, pptLayout)
 Sld.Design = ActivePresentation.Designs(1)

 End Sub

Reply | Quote