PDA

View Full Version : Calling modules from main sub



InDesigner
08-24-2016, 06:25 AM
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

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

'Open the Excel workbook. Change the filename here.
Dim OWB As New Excel.Workbook
Set OWB = Excel.Application.Workbooks.Open("C:\B\Books\TXT.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]
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

John Wilson
09-13-2016, 09:32 PM
Just for info and to make sure people do not waste time. This post appears in several other places including Stack Overflow and Microsoft Community forum, some of which have answers (it's a bug)