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
-
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.
- The code begins by declaring various objects and variables, including:
-
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 namedWordPpt
for saving the PowerPoint file. - If the folder does not exist, it is created using
MkDir
.
- The path to the company logo image is defined with
-
File Naming:
- The current date and time are formatted into a string (
CurrentDateTime
) to ensure a unique filename. This avoids overwriting previous files.
- The current date and time are formatted into a string (
-
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.
-
Presentation Creation:
- A new PowerPoint presentation is created using
PPTApp.Presentations.Add
.
- A new PowerPoint presentation is created using
-
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.
- The code iterates through each paragraph in the active Word document using a
-
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.
-
Adding Company Logo:
- The logo is added to the top-right corner of each slide, with customizable dimensions and positioning.
-
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.
- The PowerPoint presentation is saved to the
-
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