openwordtoprint.frm

内窥镜图案工作站有说明 有文档 有应用程序

        WordAppX.ChangeFileOpenDirectory App.Path & "\打印模版\"
        Set WordDocX = WordAppX.Documents.Open(filename:="云南省第一人民医院超声科3.doc", ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", format:=wdOpenFormatAuto)
        Call InsertInforInWord
        Set WordTableX = WordDocX.Tables(2)
        WordTableX.Cell(3, 1).Range.InlineShapes.AddPicture filename:=ImageFileNameIn4(NumberInWord(0)), linktofile:=False, savewithdocument:=True
        WordTableX.Cell(3, 2).Range.InlineShapes.AddPicture filename:=ImageFileNameIn4(NumberInWord(1)), linktofile:=False, savewithdocument:=True
        WordTableX.Cell(3, 3).Range.InlineShapes.AddPicture filename:=ImageFileNameIn4(NumberInWord(2)), linktofile:=False, savewithdocument:=True
        WordAppX.Application.Visible = True
    End If
    If ImageNumInWord = 4 Then
        WordAppX.ActiveDocument.Close savechanges:=wdDoNotSaveChanges
        NumberInWord(3) = Index
        WordAppX.ChangeFileOpenDirectory App.Path & "\打印模版\"
        Set WordDocX = WordAppX.Documents.Open(filename:="云南省第一人民医院超声科4.doc", ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", format:=wdOpenFormatAuto)
        Call InsertInforInWord
        Set WordTableX = WordDocX.Tables(2)
        WordTableX.Cell(1, 1).Range.InlineShapes.AddPicture filename:=ImageFileNameIn4(NumberInWord(0)), linktofile:=False, savewithdocument:=True
        WordTableX.Cell(1, 2).Range.InlineShapes.AddPicture filename:=ImageFileNameIn4(NumberInWord(1)), linktofile:=False, savewithdocument:=True
        WordTableX.Cell(2, 1).Range.InlineShapes.AddPicture filename:=ImageFileNameIn4(NumberInWord(2)), linktofile:=False, savewithdocument:=True
        WordTableX.Cell(2, 2).Range.InlineShapes.AddPicture filename:=ImageFileNameIn4(NumberInWord(3)), linktofile:=False, savewithdocument:=True
        WordAppX.Application.Visible = True
    End If
    If ImageNumInWord = 5 Then
        WordAppX.ActiveDocument.Close savechanges:=wdDoNotSaveChanges
        NumberInWord(4) = Index
        WordAppX.ChangeFileOpenDirectory App.Path & "\打印模版\"
        Set WordDocX = WordAppX.Documents.Open(filename:="云南省第一人民医院超声科5.doc", ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", format:=wdOpenFormatAuto)
        Call InsertInforInWord
        Set WordTableX = WordDocX.Tables(2)
        WordTableX.Cell(1, 1).Range.InlineShapes.AddPicture filename:=ImageFileNameIn4(NumberInWord(0)), linktofile:=False, savewithdocument:=True
        WordTableX.Cell(1, 2).Range.InlineShapes.AddPicture filename:=ImageFileNameIn4(NumberInWord(1)), linktofile:=False, savewithdocument:=True
        WordTableX.Cell(1, 3).Range.InlineShapes.AddPicture filename:=ImageFileNameIn4(NumberInWord(2)), linktofile:=False, savewithdocument:=True
        WordTableX.Cell(2, 1).Range.InlineShapes.AddPicture filename:=ImageFileNameIn4(NumberInWord(3)), linktofile:=False, savewithdocument:=True
        WordTableX.Cell(2, 2).Range.InlineShapes.AddPicture filename:=ImageFileNameIn4(NumberInWord(4)), linktofile:=False, savewithdocument:=True
        WordAppX.Application.Visible = True
    End If
    If ImageNumInWord = 6 Then
        WordAppX.ActiveDocument.Close savechanges:=wdDoNotSaveChanges
        NumberInWord(5) = Index
        WordAppX.ChangeFileOpenDirectory App.Path & "\打印模版\"
        Set WordDocX = WordAppX.Documents.Open(filename:="云南省第一人民医院超声科6.doc", ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", format:=wdOpenFormatAuto)
        Call InsertInforInWord
        Set WordTableX = WordDocX.Tables(2)
        WordTableX.Cell(1, 1).Range.InlineShapes.AddPicture filename:=ImageFileNameIn4(NumberInWord(0)), linktofile:=False, savewithdocument:=True
        WordTableX.Cell(1, 2).Range.InlineShapes.AddPicture filename:=ImageFileNameIn4(NumberInWord(1)), linktofile:=False, savewithdocument:=True
        WordTableX.Cell(1, 3).Range.InlineShapes.AddPicture filename:=ImageFileNameIn4(NumberInWord(2)), linktofile:=False, savewithdocument:=True
        WordTableX.Cell(2, 1).Range.InlineShapes.AddPicture filename:=ImageFileNameIn4(NumberInWord(3)), linktofile:=False, savewithdocument:=True
        WordTableX.Cell(2, 2).Range.InlineShapes.AddPicture filename:=ImageFileNameIn4(NumberInWord(4)), linktofile:=False, savewithdocument:=True
        WordTableX.Cell(2, 3).Range.InlineShapes.AddPicture filename:=ImageFileNameIn4(NumberInWord(5)), linktofile:=False, savewithdocument:=True
        WordAppX.Application.Visible = True
    End If

End Sub

Private Sub InsertInforInWord()    '插入信息到Word文档中的过程
    
    WordDocX.ActiveWindow.ActivePane.NewFrameset    '排版,在Word中通过录制宏得到
    WordDocX.ActiveWindow.ActivePane.Frameset.AddNewFrame (wdFramesetNewFrameRight)
    WordDocX.CommandBars("Frames").Visible = False
    WordDocX.ActiveWindow.Panes(1).Activate
    If WordDocX.ActiveWindow.View.SplitSpecial = wdPaneNone Then
        WordDocX.ActiveWindow.ActivePane.View.Type = wdPrintView
    Else
        WordDocX.ActiveWindow.View.Type = wdPrintView
    End If
    WordDocX.ActiveWindow.ActivePane.DisplayRulers = Not WordDocX.ActiveWindow.ActivePane.DisplayRulers
    With WordDocX.ActiveWindow.Document.Frameset.ChildFramesetItem(1)
        .WidthType = wdFramesetSizeTypePercent
        .Width = 86
    End With
    
    WordAppX.Visible = True    'Word文档可见
    
    Set WordTableX = WordDocX.Tables(1)    '在表格中加载病人的具体信息
    WordTableX.Cell(1, 1).Range.InsertAfter CurPatientInAll.NameInAll
    WordTableX.Cell(1, 2).Range.InsertAfter CurPatientInAll.SexInAll
    WordTableX.Cell(1, 3).Range.InsertAfter CurPatientInAll.AgeInAll
    WordTableX.Cell(1, 4).Range.InsertAfter CurPatientInAll.CheckNumInAll
    WordTableX.Cell(2, 1).Range.InsertAfter CurPatientInAll.SourceInAll
    WordTableX.Cell(2, 2).Range.InsertAfter CurPatientInAll.DepartInAll
    'WordTableX.Cell(2, 3).Range.InsertAfter CurPatientInAll.HospitalNumInAll
    'WordTableX.Cell(2, 4).Range.InsertAfter CurPatientInAll.BedNumInAll
    WordTableX.Cell(3, 1).Range.InsertAfter CurPatientInAll.InstrumentInAll
    WordTableX.Cell(3, 2).Range.InsertAfter CurPatientInAll.DiagnoseInAll
    WordTableX.Cell(3, 3).Range.InsertAfter CurPatientInAll.CheckPartInAll
    
    Set WordTableX = WordDocX.Tables(3)
    WordTableX.Cell(1, 2).Range.InsertAfter CurPatientInAll.CheckGetInAll
    WordTableX.Cell(2, 2).Range.InsertAfter CurPatientInAll.CheckCueInAll
        
    Set WordTableX = WordDocX.Tables(4)
    WordTableX.Cell(1, 2).Range.InsertAfter CurPatientInAll.CheckDocInAll
    WordTableX.Cell(2, 2).Range.InsertAfter CurPatientInAll.CheckTimeInAll
    
End Sub

Private Sub VScrBInWord_Change()    '滚动条发生改变

    FrameInWord.top = -VScrBInWord.Value

End Sub

Private Sub CmdBInWordPrint_Click()    '打印按钮,程序在Word中通过宏录制而成

    Dim WordFileSaveDir As String
    Dim WordFileName As String
    Dim WordFileDir As String
    Dim FileNumberInWord As Integer
    Dim I As Integer
    
    WordAppX.PrintOut filename:="", Range:=wdPrintAllDocument, Item:= _
        wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
        ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
        False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
        PrintZoomPaperHeight:=0
        
    WordFileSaveDir = App.Path + "\Results\" + left$(CurPatientInAll.CheckNumInAll, 8) + "\"
    WordFileName = CurPatientInAll.CheckNumInAll + ".doc"
    WordFileDir = WordFileSaveDir + WordFileName
    ChangeFileOpenDirectory WordFileSaveDir
    
    WordDocX.SaveAs filename:=WordFileName, FileFormat:= _
        wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
        True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
        False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False

End Sub

Private Sub TimerInWord_Timer()    '时间控件

    Dim WordHWND As Long    '存储Word的句柄
    Dim I As Integer
    
    WordHWND = FindWindow("OpusApp", 0&)
    If WordHWND = 0 Then
        MainForm.Visible = True
        Set WordAppX = Nothing
        Set WordDocX = Nothing
        Set WordTableX = Nothing
        If ImageBoxInWord.Count > 1 Then
            For I = 1 To ImageBoxInWord.UBound
                Unload ImageBoxInWord(I)
            Next I
        End If
        FrameInWord.Height = 1395
        FrameInWord.Visible = False
        VScrBInWord.Visible = False
        
        MainForm.MainTab.Tab = 0
        MainForm.LabelInAll(1).Caption = ""
        MainForm.LabelInAll(3).Caption = ""
        MainForm.LabelInAll(6).Caption = ""
        Call FreeType(CurPatientInAll)
        
        Unload OpenWordToPrint
    End If

End Sub