wbrword.frm

使用WebBrowser控件作为容器打开Word文档 === === === === === === === 这个源代码演示了使用WebBrowser控件作为容器打开Word文档的操作。需要在工

Private Sub mnuFile_Click(Index As Integer)

    On Error Resume Next
    
    Dim FileName As String

    Select Case Index
    
        Case FILE_OPEN
            FileName = FileDlgs.GetOpenFileName( _
                            App.Path, _
                            "Word Documents (*.doc):*.doc", _
                            "Rich Text Format (*.rtf):*.rtf")
            If Len(FileName) Then
                sta.SimpleText = "Opening " & FileName & " ..."
                wbr.Navigate FileName, mNavFlags
            End If
            
        Case FILE_CLOSE
            wbr.Navigate TITLE_PAGE, mNavFlags  ' removes Word document but
                                                ' DOES NOT close Word instance
        Case FILE_SAVE
            wbr.ExecWB _
                cmdID:=OLECMDID_SAVE, _
                cmdexecopt:=OLECMDEXECOPT_PROMPTUSER
                
        Case FILE_SAVEAS
            wbr.ExecWB _
                cmdID:=OLECMDID_SAVEAS, _
                cmdexecopt:=OLECMDEXECOPT_PROMPTUSER
                
        Case FILE_SAVEASHTML
            FileSaveAsHTML
            
        Case FILE_PAGESETUP
            wbr.ExecWB _
                cmdID:=OLECMDID_PAGESETUP, _
                cmdexecopt:=OLECMDEXECOPT_PROMPTUSER
                
        Case FILE_PRINT
            wbr.ExecWB _
                cmdID:=OLECMDID_PRINT, _
                cmdexecopt:=OLECMDEXECOPT_PROMPTUSER
                
        Case FILE_CLOSEWIN
            Unload Me
            
    End Select

End Sub

Private Sub mnuFileProps_Click(Index As Integer)
'
' See VbaWrd8.HLP for distinction between "Show" and "Display" methods
'
    On Error Resume Next
    
    Select Case Index
    
        Case PROP_SUMMARY  ' Word Document Summary Info
            mDoc.Application.Dialogs(wdDialogFileSummaryInfo).Show
            
        Case PROP_WORDCOUNT  ' Word Document Word Count (display only)
            mDoc.Application.Dialogs(wdDialogToolsWordCount).Display
            
    End Select
        
End Sub

Private Sub mnuViewMenu_Click()

    On Error Resume Next
    
    Dim mnu As Menu
    
    With mDoc
    
        With .ActiveWindow
            mnuView(VIEW_NORMAL).Checked = (.View.Type = wdNormalView)
            mnuView(VIEW_PAGE).Checked = (.View.Type = wdPageView)
            mnuView(VIEW_HSCROLL).Checked = .DisplayHorizontalScrollBar
            mnuView(VIEW_RULER).Checked = .DisplayRulers
        End With
        
        For Each mnu In mnuViewToolbar  ' Assumes Menu captions match Toolbar names
            mnu.Checked = .CommandBars(mnu.Caption).Visible
        Next
        
    End With

End Sub

Private Sub mnuView_Click(Index As Integer)

    On Error Resume Next
    
    With mDoc.ActiveWindow
    
        Select Case Index
        
            Case VIEW_NORMAL
                .View.Type = wdNormalView
                
            Case VIEW_PAGE
                .View.Type = wdPageView
                
            Case VIEW_HSCROLL
                .DisplayHorizontalScrollBar = Not .DisplayHorizontalScrollBar
                
            Case VIEW_RULER
                .DisplayRulers = Not .DisplayRulers
          
        End Select
    
    End With
    
End Sub

Private Sub mnuViewToolbar_Click(Index As Integer)

    On Error Resume Next
    
    Dim msoBarPos As Office.MsoBarPosition
    Dim strToolbarName As String
    
    strToolbarName = mnuViewToolbar(Index).Caption
    
    With mDoc.CommandBars(strToolbarName)
    
        .Enabled = True ' ToolBar must be Enabled before it can be made Visible
        .Visible = Not .Visible
        mnuViewToolbar(Index).Checked = .Visible
        
        If .Visible Then
        
            Select Case strToolbarName
            
                Case "Drawing"
                    msoBarPos = msoBarBottom
                    
                Case "Reviewing"
                    msoBarPos = msoBarRight
                    
                Case Else
                    msoBarPos = msoBarTop
            End Select
            
            .Position = msoBarPos
            
        End If
        
    End With

End Sub

Private Sub mnuToolsMenu_Click()

    On Error Resume Next
    
    With mDoc
    
        mnuTools(TOOLS_SPELL) = Not .SpellingChecked
        
        With .Application.Selection ' restrict to one word only
            mnuTools(TOOLS_THESAURUS) = (.Type = wdSelectionNormal) _
                                    And (.Words.Count = 1)
        End With
        
    End With
    
End Sub

Private Sub mnuTools_Click(Index As Integer)

    On Error Resume Next
    
    Select Case Index
    
        Case TOOLS_SPELL
            mDoc.CheckSpelling
        
        Case TOOLS_THESAURUS
            mDoc.Application.Selection.Range.CheckSynonyms
            
        Case TOOLS_OPTIONS
            mnuOpt(OPT_SHOWALL).Checked = mDoc.ActiveWindow.View.ShowAll
            mnuOpt(OPT_STATUSBAR).Checked = sta.Visible
            
    End Select
    
End Sub

Private Sub mnuOpt_Click(Index As Integer)

    On Error Resume Next

    Dim blnChecked As Boolean
    
    With mnuOpt(Index)
        .Checked = Not .Checked
        blnChecked = .Checked
    End With
    
    Select Case Index
    
        Case OPT_SHOWALL
            mDoc.ActiveWindow.View.ShowAll = blnChecked
           
        Case OPT_STATUSBAR
            sta.Visible = blnChecked
            SetBotUsedArea
            
    End Select
    
End Sub

Private Sub wbr_DocumentComplete(ByVal pDisp As Object, URL As Variant)

    On Error GoTo DocumentComplete_Error
    
    If pDisp Is wbr.Object Then
    
        mnuViewMenu = TypeOf wbr.Document Is Word.Document
        mnuToolsMenu = mnuViewMenu
        
        If mnuViewMenu Then
            Set mDoc = wbr.Document
            mDocURL = URL
            Me.Caption = mDocURL
            sta.SimpleText = "Done"
        Else
            Set mDoc = Nothing
            mDocURL = vbNullString
            Me.Caption = Me.Tag
        End If
        
    End If
    
DocumentComplete_Exit:
    Exit Sub
    
DocumentComplete_Error:
    MsgBox Err.Number & " - " & Err.Description, vbExclamation, _
                Me.Name & ".DocumentComplete"
    Resume DocumentComplete_Exit
    
End Sub

Private Sub wbr_StatusTextChange(ByVal Text As String)

    sta.SimpleText = Text
    
End Sub

Private Sub FileSaveAsHTML()
'
' This can also be done with the "SaveAs" option.
' Note that ConvHTML.SaveDocAsHTML could be used to convert a
' document to HTML withtout user intervention if parameters
' are provided by some other means.

    On Error GoTo FileSaveAsHTML_Error
    
    Dim FileName As String
    Dim lngPos As Long
    Dim strResult As String
    Dim strMsg As String
    Dim lngStyle As VbMsgBoxStyle
    
    lngPos = InStrRev(mDocURL, "\", , vbTextCompare)
    If lngPos Then
        FileName = Mid$(mDocURL, lngPos + 1)
        FileName = Split(FileName, ".")(0) & ".html"
        FileName = LCase$(FileName)
    End If

    strResult = FileDlgs.GetSaveAsFileName( _
                    FileName, _
                    App.Path, _
                    "HTML Document (*.htm;*.html):*.htm;*.html")
                    
    If Len(strResult) Then
        FileName = ConvHTML.SaveDocAsHTML( _
                    Doc:=mDoc, _
                    NewFileName:=strResult)
        If Len(FileName) Then
            strMsg = mDocURL & vbNewLine & vbNewLine _
                    & vbTab & "saved in HTML format as" & vbNewLine & vbNewLine _
                    & FileName
            lngStyle = vbInformation
        Else
            strMsg = "ERROR: Save operation failed"
            lngStyle = vbExclamation
        End If
        MsgBox strMsg, lngStyle, "Save As HTML"
    End If
    
FileSaveAsHTML_Exit:
    Exit Sub
    
FileSaveAsHTML_Error:
    MsgBox Err.Number & " - " & Err.Description, vbExclamation, _
                Me.Name & ".FileSaveAsHTML"
    Resume FileSaveAsHTML_Exit

End Sub

Private Sub SetBotUsedArea()

    With sta
        .Refresh
        mBotUsedArea = IIf(.Visible, .Height + MARGIN, MARGIN)
    End With
    mVertUsedArea = mTopUsedArea + mBotUsedArea
    Form_Resize
    
End Sub