Microsoft KB Archive/168768
Article ID: 168768
Article Last Modified on 10/11/2006
- Microsoft PowerPoint 97 Standard Edition
This article was previously published under 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. This includes, but is not limited to, the implied warranties of merchantability or fitness for a particular purpose. This article assumes that you are familiar with the programming language that is being demonstrated and with the tools that are used to create and to debug procedures. Microsoft support engineers 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 requirements.
What the Macro Does
The following style information is retrieved from Microsoft Word:
- Name of font
All other formatting is ignored, but you can modify this macro to apply additional formatting information if needed.
The following table illustrates how the styles from Word are mapped to the slide master in 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)|
Preparing to Run the Macro
This macro contains code that you place in a module and a class module. Place the procedure called "Main" in a module; place the rest of the code in a class module named "WordObject." To prepare this macro to run, use the following steps:
- Start the Visual Basic Editor:
- Start PowerPoint 97, and open or create a presentation.
- On the Tools menu, point to Macro, and click Visual Basic Editor.
- To insert a module into a project, click Module on the Insert menu.
In the module you just created, type the code that starts with:
and ends with:
' End of Main. End Sub
- To insert a class module into the project, click Class Module on the Insert menu.
- Change the name of the class module to WordObject:
- In the Project Explorer, open the Class Modules folder.
NOTE: If the Project Explorer is closed, click Project Explorer on the View menu to open it.
- Click the Class1 module. Class1 is the default name given to a class module you create. If you create another new module, it will be named Class2, and then Class3, and so on.
- View the property sheet for the Class1 module. If the properties window is closed, click Properties Window on the View menu.
- Highlight Class1 to the right of (Name). Change the name to WordObject. (Use the same case.)
- In the Project Explorer, open the Class Modules folder.
In the class module you just created, type the code that starts with:
' Start of WordObject class.
and ends with:
' End of WordObject class.
- Add a reference to the Word object model:
- On the Tools menu (in the Visual Basic Editor), click References.
- Click to select the "Microsoft Word 8.0 Object Library" check box.
- Click OK.
- Run the macro in PowerPoint:
- On the Tools menu, point to Macro, and then click Macros.
- Select the macro named Main, and click Run.
The Macro Code
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 more information about how to use the sample code in this article, click the article number below to view the article in the Microsoft Knowledge Base:
173707 OFF97: How to Run Sample Code from Knowledge Base Articles
Additional query words: 8.00 ppt8 ppt97 vba vbe vb
Keywords: kbcode kbdtacode kbhowto kbinterop kbprogramming KB168768