VBA: Assigning Word Styles to the PowerPoint Slide MasterID: Q168768
|
To achieve a consistent look for documents created in Microsoft Office, it is possible to use formatting information from one Office program in another Office program. The "More Information" section of this article provides a sample Microsoft Visual Basic for Applications macro (Sub procedure) that retrieves heading styles from Microsoft Word and applies them to the slide master in Microsoft PowerPoint.
Microsoft provides programming examples for illustration only, without
warranty either expressed or implied, including, but not limited to, the
implied warranties of merchantability and/or fitness for a particular
purpose. This article assumes that you are familiar with the programming
language being demonstrated and the tools used to create and debug
procedures. Microsoft Support professionals can help explain the functionality
of a particular procedure, but they will not modify these examples to
provide added functionality or construct procedures to meet your specific
needs. If you have limited programming experience, you may want to contact
the Microsoft fee-based consulting line at (800) 936-5200. For more
information about the support options available from Microsoft, please see
the following page on the World Wide Web:
http://support.microsoft.com/support/
Word | PowerPoint |
---|---|
Heading 1 | Title of slide master (title placeholder) |
Heading 2 | First level indent (in the body placeholder) |
Heading 3 | Second level indent (in the body placeholder) |
Heading 4 | Third level indent (in the body placeholder) |
Heading 5 | Fourth level indent (in the body placeholder) |
Heading 6 | Fifth level indent (in the body placeholder) |
Sub Main()
and ends with:
' End of Main.
End Sub
' Start of WordObject class.
and ends with:
' End of WordObject class.
Sub Main()
Const strMacroName = "Get Word Styles"
Dim oWord As New WordObject
Dim lResult As Long
With oWord
' Check if a document is open in Word.
If .IsDocOpen = False Then
' Prompt the user to open a document if no document is open.
lResult = MsgBox("No document is open in Word. Would you " _
& "like to open a document?", vbOKCancel + vbExclamation, _
strMacroName)
' Check if the user clicked OK.
If lResult = vbOK Then
.OpenDocPrompt
Else
' The user clicked Cancel. Free resources, and end the macro
.FreeWord
End
End If
End If
' Get the Heading 1 styles and apply them to the slide master
' title.
.GetStyles 1
End With
' Apply the Heading 1 styles to title in the slide master.
With ActivePresentation.SlideMaster.Shapes.Title.TextFrame.TextRange
.Font.Name = oWord.Fontname
.Font.Bold = oWord.Bold
.Font.Shadow = oWord.Shadow
.Font.Underline = oWord.Underline
.Font.Italic = oWord.Italic
End With
' Loop through and apply all the Word heading styles to the body
' placeholder.
Dim x As Long
For x = 2 To 6
' Getting Heading 2 styles
oWord.GetStyles x
' Apply heading to styles (retrieved from Word) to the first line
' in the placeholder.
With ActivePresentation.SlideMaster.Shapes.Placeholders(ppPlaceholderBody).TextFrame
.TextRange.Lines(x - 1).Font.Name = oWord.Fontname
.TextRange.Lines(x - 1).Font.Bold = oWord.Bold
.TextRange.Lines(x - 1).Font.Shadow = oWord.Shadow
.TextRange.Lines(x - 1).Font.Underline = oWord.Underline
.TextRange.Lines(x - 1).Font.Italic = oWord.Italic
End With
Next x
' Check if Word was started by the macro.
If oWord.WasStarted = False Then
MsgBox "Successfully imported heading styles from Word." _
, vbInformation, strMacroName
End If
' End of Main.
End Sub
WordObject Class code:
' Start of WordObject class.
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As Long) As Long
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" _
(ByVal hwnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal wType As Long) As Long
Private Const MB_YESNO = &H4&
Private Const MB_QUESTION = &H20&
Private Const IDYES = 6
' Add all private variables here.
' This member holds an object reference to Word. If an object reference
' was not set, this value will be set to Nothing.
Private m_oWordRef As Object
' This variable is set to FALSE if GetObject was used to obtain
' an object reference or if a Word reference could not be obtained.
' This variable is set to TRUE if CreateObject was used to obtain
' an object reference.
Private m_bStarted As Boolean
' This holds the font name for a heading style.
Private m_strFontName As String
' This holds the bold information for a font.
Private m_lBold As Long
' This holds the italic information.
Private m_lItalic As Long
' This holds the underline information.
Private m_lUnderline As Long
' This holds the shadow information.
Private m_lShadow As Long
Private Sub Class_Initialize()
' This function initializes all members of the class to
' their default values.
InitMembers
' Used to trap GetObject if it fails.
On Error Resume Next
Err.Clear
' Attempt to get a reference to the Word object.
Set m_oWordRef = GetObject(, "Word.Application.8")
' Check if error occurred during GetObject.
If Err.Number <> 0 Then
' Clear the error object.
Err.Clear
' Attempt to get a reference to the Word object.
Set m_oWordRef = CreateObject("Word.Application.8")
' Check if error occurred when calling CreateObject.
If Err.Number <> 0 Then
Set m_oWordRef = Nothing
m_bStarted = False
Else
' CreateObject obtained a Word object reference.
m_bStarted = True
End If
End If
End Sub
Private Sub Class_Terminate()
Dim lResult As Long
Dim hwnd As Long
' Check if Word was started by the macro.
' If Word was started by the macro, quit Word, and
' set the Word object reference to Nothing.
If m_bStarted = True Then
' Get a handle to the main window of Word.
hwnd = FindWindow("OpusApp", 0&)
Dim strCaption As String
strCaption = "Word was started by this macro. Would you " _
& "like to close Word?"
' Ask the user if they would like to close Word.
lResult = MessageBox(hwnd, strCaption, "Get Word Styles", _
MB_YESNO + MB_QUESTION)
' Check if the user clicked Yes.
If lResult = IDYES Then
' Quit Microsoft Word.
m_oWordRef.Quit
End If
End If
' No matter what, set the Word object reference to
' Nothing.
Set m_oWordRef = Nothing
End Sub
' This subroutine initializes all member variables in
' the class.
Private Sub InitMembers()
Set m_oWordRef = Nothing
m_bStarted = False
' This initializes all members that relate to styles.
InitHeadingMembers
End Sub
Private Sub InitHeadingMembers()
' Initializes the members related to the heading style.
m_strFontName = ""
m_lBold = -1
m_lItalic = -1
m_lUnderline = -1
m_lShadow = -1
End Sub
' Call this member to trigger the class construction.
Public Sub Create()
End Sub
Public Function IsDocOpen() As Boolean
' Check if any documents are open in Word.
' The macro grabs the styles from the active
' document, so a document must be open.
If m_oWordRef.Documents.Count = 0 Then
IsDocOpen = False
Else
IsDocOpen = True
End If
End Function
Public Sub OpenDocPrompt()
Dim lAnswer As Long
' Check if Word is visible.
If m_oWordRef.Visible = False Then
m_oWordRef.Visible = True
End If
' Give focus to Word.
m_oWordRef.Activate
' Display the Open dialog box in Word.
lAnswer = m_oWordRef.Dialogs(wdDialogFileOpen).Show
' If they click Cancel, close the macro.
If lAnswer <> -1 Then
Class_Terminate
End
End If
End Sub
Public Sub FreeWord()
Class_Terminate
End Sub
Public Sub GetStyles(lStyleNumber As Long)
Dim lStyle As Long
' Determine which heading to obtain.
Select Case lStyleNumber
' Heading 1
Case 1
lStyle = wdStyleHeading1
' Heading 2
Case 2
lStyle = wdStyleHeading2
' Heading 3
Case 3
lStyle = wdStyleHeading3
' Heading 4
Case 4
lStyle = wdStyleHeading4
' Heading 5
Case 5
lStyle = wdStyleHeading5
' Heading 6
Case 6
lStyle = wdStyleHeading5
Case Else
lStyle = wdStyleHeading1
End Select
' Populate the style variables.
With m_oWordRef.ActiveDocument.Styles(lStyle).Font
m_strFontName = .Name
m_lBold = .Bold
m_lShadow = .Shadow
m_lItalic = .Italic
m_lUnderline = .Underline
End With
End Sub
' Returns the m_strFontName member value
Public Property Get Fontname() As String
Fontname = m_strFontName
End Property
' Returns the m_lBold member value.
Public Property Get Bold() As Long
Bold = m_lBold
End Property
' Returns the m_lShadow member value.
Public Property Get Shadow() As Long
Shadow = m_lShadow
End Property
' Returns the m_lItalic member value.
Public Property Get Italic() As Long
Italic = m_lItalic
End Property
' Returns the m_lUnderline member value.
Public Property Get Underline() As Long
Underline = m_lUnderline
End Property
' Returns whether Word was started by the macro or not.
Public Property Get WasStarted() As Boolean
WasStarted = m_bStarted
End Property
' End of WordObject class.
For additional information, please see the following article in the
Microsoft Knowledge Base:
Q173707 OFF97: How to Run Sample Code from Knowledge Base Articles
Additional query words: 8.00 ppt8 ppt97 vba vbe vb
Keywords : kbcode kbinterop kbprg kbdta kbdtacode OffVBA KbVBA kbpptvba
Version : WINDOWS:97
Platform : WINDOWS
Issue type : kbhowto
Last Reviewed: June 24, 1999