Results 1 to 1 of 1
  1. #1
    New Lounger
    Join Date
    Aug 2016
    Thanked 0 Times in 0 Posts

    Calling modules from main sub

    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 ---
     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.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
     'Close Excel
     'Delete presentation
     End Sub
     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
     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
     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
    Last edited by RetiredGeek; 2016-08-24 at 08:46. Reason: Added Code Tags

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts