Thursday, September 26, 2024

VBA Code for Exporting Word Paragraphs to PowerPoint

Objective

The purpose of this VBA code is to automate the process of exporting paragraphs from a Microsoft Word document into a PowerPoint presentation. Each paragraph is transformed into a separate slide, with the option to include a title and a company logo. Additionally, the PowerPoint file is saved in a specified folder on the Desktop, with a unique filename that incorporates the current date and time.


Sub ExportParagraphsToPowerPoint()
    Dim PPTApp As Object
    Dim PPTPresentation As Object
    Dim PPTSlide As Object
    Dim PPTShape As Object
    Dim WordParagraph As Paragraph
    Dim SlideText As String
    Dim SlideTitle As String
    Dim SlideWidth As Single
    Dim SlideHeight As Single
    Dim LogoPath As String
    Dim TitleShape As Object
    Dim LogoShape As Object
    Dim DesktopPath As String
    Dim FolderPath As String
    Dim PPTFilePath As String
    Dim CurrentDateTime As String
    
    ' Define the path to your company logo image
    LogoPath = "C:\Users\ajeet\Desktop\Appliedk\logo.png"
    
    ' Get the path to the Desktop
    DesktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    FolderPath = DesktopPath & "\WordPpt" ' Folder where the PPT will be saved

    ' Check if folder exists, if not, create it
    If Dir(FolderPath, vbDirectory) = "" Then
        MkDir FolderPath
    End If
    
    ' Create a formatted date and time string for the filename
    CurrentDateTime = Format(Now, "yyyy-mm-dd_hh-nn-ss")
    
    ' Set the full path for saving the PowerPoint file
    PPTFilePath = FolderPath & "\ExportedPPT_" & CurrentDateTime & ".pptx"

    ' Create a new instance of PowerPoint (Make PowerPoint invisible during processing)
    On Error Resume Next
    Set PPTApp = GetObject(, "PowerPoint.Application")
    If PPTApp Is Nothing Then
        Set PPTApp = CreateObject("PowerPoint.Application")
    End If
    PPTApp.Visible = False ' Make PowerPoint invisible during processing
    On Error GoTo 0
    
    ' Create a new PowerPoint presentation
    Set PPTPresentation = PPTApp.Presentations.Add

    ' Get slide dimensions for reference
    SlideWidth = PPTPresentation.PageSetup.SlideWidth
    SlideHeight = PPTPresentation.PageSetup.SlideHeight

    ' Loop through each paragraph in the Word document
    For Each WordParagraph In ActiveDocument.Paragraphs
        SlideText = WordParagraph.Range.Text
        ' Remove any extra line breaks or spaces from the paragraph text
        SlideText = Trim(SlideText)
        
        ' Check if the paragraph contains text (skip empty paragraphs)
        If Len(SlideText) > 0 Then
            ' Add a new slide with a blank layout (layout ID 12)
            Set PPTSlide = PPTPresentation.Slides.Add(PPTPresentation.Slides.Count + 1, 12)
            
            ' Add a title at the top of the slide
            SlideTitle = "Slide " & PPTPresentation.Slides.Count ' You can customize the title format as needed
            Set TitleShape = PPTSlide.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
                                                        Left:=50, Top:=20, Width:=SlideWidth - 100, Height:=50)
            TitleShape.TextFrame.TextRange.Text = SlideTitle
            With TitleShape.TextFrame.TextRange.Font
                .Name = "Arial" ' Change font style here
                .Size = 28      ' Set title font size
                .Bold = msoTrue ' Title in bold
            End With
            
            ' Set position and size of the text box (modify as needed)
            Dim textBoxLeft As Single
            Dim textBoxTop As Single
            Dim textBoxWidth As Single
            Dim textBoxHeight As Single
            
            ' Customize the position and size of the text box for the paragraph content
            textBoxLeft = 50       ' Distance from the left side (in points)
            textBoxTop = 100       ' Distance from the top (in points)
            textBoxWidth = 500     ' Width of the text box (in points)
            textBoxHeight = 300    ' Height of the text box (in points)
            
            ' Add the text box to the slide
            Set PPTShape = PPTSlide.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
                                                      Left:=textBoxLeft, Top:=textBoxTop, _
                                                      Width:=textBoxWidth, Height:=textBoxHeight)
                                                      
            ' Add paragraph text to the text box
            PPTShape.TextFrame.TextRange.Text = SlideText
            
            ' Set font size and style for paragraph text
            With PPTShape.TextFrame.TextRange.Font
                .Name = "Arial" ' Change font style here
                .Size = 24      ' Set paragraph font size
                .Bold = msoFalse ' Optional: remove bold
            End With
            
            ' Add the company logo to the top-right corner
            Dim logoLeft As Single
            Dim logoTop As Single
            Dim logoWidth As Single
            Dim logoHeight As Single
            
            ' Set the position and size for the logo
            logoWidth = 100    ' Adjust width of logo
            logoHeight = 100   ' Adjust height of logo
            logoLeft = SlideWidth - logoWidth - 20 ' Positioned 20 points from the right
            logoTop = 20       ' Positioned 20 points from the top
            
            ' Add the logo image to the slide
            Set LogoShape = PPTSlide.Shapes.AddPicture(LogoPath, _
                                                       LinkToFile:=msoFalse, _
                                                       SaveWithDocument:=msoTrue, _
                                                       Left:=logoLeft, Top:=logoTop, _
                                                       Width:=logoWidth, Height:=logoHeight)
        End If
    Next WordParagraph
    
    ' Save the PowerPoint file in the "WordPpt" folder on the Desktop
    PPTPresentation.SaveAs PPTFilePath
    
    ' Close the PowerPoint presentation
    PPTPresentation.Close
    
    ' Cleanup
    Set PPTShape = Nothing
    Set PPTSlide = Nothing
    Set PPTPresentation = Nothing
    PPTApp.Quit ' Close PowerPoint
    Set PPTApp = Nothing
    
    ' Display "Done PPT" message
    MsgBox "Done PPT", vbInformation
End Sub 

Code Breakdown

  1. Variable Declarations:

    • The code begins by declaring various objects and variables, including:
      • PPTApp: The PowerPoint application object.
      • PPTPresentation: The PowerPoint presentation object.
      • PPTSlide: Represents individual slides within the presentation.
      • PPTShape: Represents shapes (text boxes) on the slides.
      • WordParagraph: Represents each paragraph in the Word document.
      • Other variables for text, dimensions, logo path, and file paths.
  2. Logo and Path Setup:

    • The path to the company logo image is defined with LogoPath.
    • The desktop path is retrieved using WScript.Shell to create a folder named WordPpt for saving the PowerPoint file.
    • If the folder does not exist, it is created using MkDir.
  3. File Naming:

    • The current date and time are formatted into a string (CurrentDateTime) to ensure a unique filename. This avoids overwriting previous files.
  4. PowerPoint Application Handling:

    • The code attempts to get an existing instance of PowerPoint. If not found, it creates a new instance.
    • The PowerPoint application is set to be invisible during the processing (PPTApp.Visible = False) to enhance user experience.
  5. Presentation Creation:

    • A new PowerPoint presentation is created using PPTApp.Presentations.Add.
  6. Looping Through Word Paragraphs:

    • The code iterates through each paragraph in the active Word document using a For Each loop.
    • It trims any leading or trailing spaces from the paragraph text and checks if it is non-empty.
    • For each valid paragraph, a new slide is added to the presentation with a blank layout.
  7. Adding Title and Content:

    • A title is added to each slide, formatted with specific font settings (e.g., Arial, size 28, bold).
    • A text box is created for the paragraph content, with customizable dimensions and font settings (e.g., Arial, size 24).
    • The text box is positioned within the slide based on specified left, top, width, and height parameters.
  8. Adding Company Logo:

    • The logo is added to the top-right corner of each slide, with customizable dimensions and positioning.
  9. Saving the Presentation:

    • The PowerPoint presentation is saved to the WordPpt folder on the Desktop, using the generated filename that includes the date and time.
  10. Cleanup and Closure:

    • The code cleans up by closing the PowerPoint presentation and quitting the PowerPoint application.
    • Finally, a message box is displayed to notify the user that the process is complete with the message "Done PPT".

Conclusion

This VBA code provides an efficient way to convert paragraphs from a Word document into a structured PowerPoint presentation, enhancing productivity for users who frequently create presentations from text content. The ability to customize titles, text formatting, and logo placement adds further utility, while the automatic file naming prevents data loss from overwriting.

No comments:

Post a Comment

Hot Topics