bill_sctzd.cls

金蝶k3财务软件生产管理BOS打印插件源程序,通过调用word实现

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Bill_sctzd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Description = "This is BillEvent Interface Class, made by K3BOSPLUGINSWIZAED"
 
'定义 BillEvent 接口. 必须具有的声明, 以此来获得事件
Private WithEvents m_Bill  As BillEvent
Attribute m_Bill.VB_VarHelpID = -1
 
Public Sub Show(ByVal oBillInterface As Object)
 
    'BillEvent 接口实现
    '注意: 此方法必须存在, 请勿修改
    Set m_Bill = oBillInterface
End Sub

Private Sub Class_Terminate()
 
    '释放接口对象
    '注意: 此方法必须存在, 请勿修改
    Set m_Bill = Nothing

End Sub

Private Sub m_Bill_AfterCopyBill()
    m_Bill.SetFieldValue "FBillNo", m_Bill.GetFieldValue("FwNoID", , Enu_ValueType_FFND)

End Sub

Private Sub m_Bill_AfterLoadBill()
    If m_Bill.GetFieldValue("FzfTag") = "已作废" Then
        m_Bill.LockBill
    End If
    
End Sub

Private Sub m_Bill_AfterNewBill()
    m_Bill.SetFieldValue "Fzddate", Date
End Sub

Private Sub m_Bill_MenuBarClick(ByVal BOSTool As K3ClassEvents.BOSTool, Cancel As Boolean)
 
    Select Case BOSTool.ToolName
    Case "Word"
        '此处添加处理 Word 菜单对象的 Click 事件
        DoPrint
    Case "wZf"
        If m_Bill.GetFieldValue("FzfTag") = "已作废" Then
            m_Bill.SetFieldValue "FzfTag", ""
            m_Bill.SetFieldValue "Fzfr", ""
        Else
            m_Bill.SetFieldValue "FzfTag", "已作废"
            m_Bill.SetFieldValue "Fzfr", m_Bill.K3Lib.User.UserName
            m_Bill.SetFieldValue "FDate_zf", CStr(Date)
        End If
    Case Else
    End Select

End Sub

Private Sub m_Bill_MenuBarInitialize(ByVal oMenuBar As K3ClassEvents.MenuBar)
 
    Dim oTool   As K3ClassEvents.BOSTool
    Dim oBand   As K3ClassEvents.BOSBand
 
'*************** 开始新增 BOS 菜单 ***************
 
    '新增 Word 菜单对象，并设置属性
    Set oTool = oMenuBar.BOSTools.Add("Word")
    With oTool
        .Caption = "Word"
        .ToolTipText = "用Word打印"
        .Description = "Word"
        .ShortcutKey = 0
        .Visible = True
        .Enabled = True
        .BeginGroup = True
        .ToolPicture = App.Path & "\PRINT.BMP"
        .SetPicture 0, vbButtonFace
    End With
 
    Set oBand = oMenuBar.BOSBands("BandToolBar")
    oBand.BOSTools.InsertAfter "mnuFilePreview", oTool  '将菜单对象插入指定工具栏
 
 
    '新增 作废 菜单对象，并设置属性
    Set oTool = oMenuBar.BOSTools.Add("wZf")
    With oTool
        .Caption = "作废"
        .ToolTipText = "用Word打印"
        .Description = "作废"
        .ShortcutKey = 0
        .Visible = True
        .Enabled = True
        .BeginGroup = True
        .ToolPicture = App.Path & "\TRASH02A.ICO"
        .SetPicture 0, vbButtonFace
    End With
 
    Set oBand = oMenuBar.BOSBands("BandToolBar")
    oBand.BOSTools.InsertAfter "mnuFilePreview", oTool  '将菜单对象插入指定工具栏

 
'*************** 结束新增 BOS 菜单 ***************
 

End Sub

Private Sub DoPrint()
    Dim w As New Word.Application
    Dim d As Document
    
    On Error Resume Next
   
    w.Visible = True
    
    FileCopy App.Path & "\FGPrint.doc", "c:\BOSPlus\FGPrint.doc"
    
    Set d = w.Documents.Open("c:\BOSPlus\FGPrint.doc")    '.Add(DocumentType:=wdNewBlankDocument)
    
    w.Selection.MoveDown Unit:=wdLine, Count:=2
    If m_Bill.GetFieldValue("FzfTag") = "已作废" Then
       w.Selection.TypeText Text:="（ 作废 ）"
    End If
    w.Selection.MoveDown Unit:=wdLine, Count:=1
    w.Selection.TypeText Text:="委印单位:" & m_Bill.GetFieldValue("FkhID", , Enu_ValueType_FDSP) & "   类型：" & m_Bill.GetFieldValue("FworklxID", , Enu_ValueType_FDSP) & "           №:" & m_Bill.GetFieldValue("FBillNo")
    w.Selection.MoveDown Unit:=wdLine, Count:=1
    w.Selection.MoveLeft Unit:=wdCell, Count:=50
    w.Selection.MoveRight Unit:=wdCell, Count:=1
    w.Selection.TypeText Text:=m_Bill.GetFieldValue("FBaseProperty", , Enu_ValueType_FDSP)
    w.Selection.MoveRight Unit:=wdCell, Count:=2
    w.Selection.TypeText Text:=m_Bill.GetFieldValue("Fsl") & m_Bill.GetFieldValue("FBase", , Enu_ValueType_FDSP)
    w.Selection.MoveRight Unit:=wdCell, Count:=2
    w.Selection.TypeText Text:=m_Bill.GetFieldValue("FDate_jh")
    
    Dim rows As Long
    rows = GetRows(2)
    Dim i As Long
    w.Selection.MoveRight Unit:=wdCell, Count:=6
    For i = 1 To rows
        w.Selection.MoveRight Unit:=wdCell, Count:=1
        w.Selection.TypeText Text:=m_Bill.GetFieldValue("FBaseProperty2", i) & "  " & m_Bill.GetFieldValue("FcpxmID", i, Enu_ValueType_FDSP) & "(" & m_Bill.GetFieldValue("FBaseProperty1", i) & ")"
        w.Selection.MoveRight Unit:=wdCell, Count:=1
        w.Selection.TypeText Text:=m_Bill.GetFieldValue("Fzsdz", i) & m_Bill.GetFieldValue("FBase2", i, Enu_ValueType_FDSP)
        w.Selection.MoveRight Unit:=wdCell, Count:=1
        w.Selection.TypeText Text:=m_Bill.GetFieldValue("Fxhsl", i) & m_Bill.GetFieldValue("FBase2", i, Enu_ValueType_FDSP) & "(" & m_Bill.GetFieldValue("Fxh", i) & "%)"
        w.Selection.MoveRight Unit:=wdCell, Count:=1
        w.Selection.TypeText Text:=m_Bill.GetFieldValue("Fjhyzzs", i) & m_Bill.GetFieldValue("FBase2", i, Enu_ValueType_FDSP)
        w.Selection.MoveRight Unit:=wdCell, Count:=1
        w.Selection.TypeText Text:=m_Bill.GetFieldValue("Fde", i) & "(kg/万张)"
        w.Selection.MoveRight Unit:=wdCell, Count:=1
        w.Selection.TypeText Text:=m_Bill.GetFieldValue("Fdh", i) & "(kg/万张)"
    Next
    
    w.Selection.MoveDown Unit:=wdLine, Count:=2
    w.Selection.MoveLeft Unit:=wdCell, Count:=50
    w.Selection.MoveRight Unit:=wdCell, Count:=5
    
    rows = GetRows(3)
    For i = 1 To rows
        w.Selection.MoveRight Unit:=wdCell, Count:=1
        w.Selection.TypeText Text:=m_Bill.GetFieldValue("FBaseProperty3", i) & "  " & m_Bill.GetFieldValue("FBase1", i, Enu_ValueType_FDSP)
        w.Selection.MoveRight Unit:=wdCell, Count:=1
        w.Selection.TypeText Text:=m_Bill.GetFieldValue("Fhdyl", i) & m_Bill.GetFieldValue("FBase3", i, Enu_ValueType_FDSP)
        
    Next
    
    w.Selection.MoveDown Unit:=wdLine, Count:=2
    w.Selection.MoveLeft Unit:=wdCell, Count:=50
    w.Selection.MoveRight Unit:=wdCell, Count:=7
    
    rows = GetRows(4)
    For i = 1 To rows
        w.Selection.MoveRight Unit:=wdCell, Count:=1
        w.Selection.TypeText Text:=m_Bill.GetFieldValue("FscgyID", i, Enu_ValueType_FDSP)
        w.Selection.MoveRight Unit:=wdCell, Count:=1
        w.Selection.TypeText Text:=m_Bill.GetFieldValue("FbmID", i, Enu_ValueType_FDSP)
        w.Selection.MoveRight Unit:=wdCell, Count:=1
        w.Selection.TypeText Text:=m_Bill.GetFieldValue("Ffjsl", i) & "(" & m_Bill.GetFieldValue("Fxhfj", i) & "%)"
        w.Selection.MoveRight Unit:=wdCell, Count:=1
        w.Selection.TypeText Text:=m_Bill.GetFieldValue("Fjhscdate", i)
        w.Selection.MoveRight Unit:=wdCell, Count:=1
        w.Selection.TypeText Text:=m_Bill.GetFieldValue("Fscjy", i)
        w.Selection.MoveRight Unit:=wdCell, Count:=1
        w.Selection.TypeText Text:=m_Bill.GetFieldValue("Fzxs", i)
        w.Selection.MoveRight Unit:=wdCell, Count:=1
        w.Selection.TypeText Text:=m_Bill.GetFieldValue("Fsczq", i) & "天"
        w.Selection.MoveRight Unit:=wdCell, Count:=1
        w.Selection.TypeText Text:=m_Bill.GetFieldValue("Fworks", i) & "时"

    Next
    w.Selection.MoveDown Unit:=wdLine, Count:=2
    w.Selection.MoveLeft Unit:=wdCell, Count:=50
    'w.Selection.MoveRight Unit:=wdCell, Count:=1
    w.Selection.TypeText Text:=m_Bill.GetFieldValue("FNote")
    w.Selection.TypeParagraph
    w.Selection.MoveDown Unit:=wdLine, Count:=1
    w.Selection.TypeText Text:="制单人：" & m_Bill.GetFieldValue("FBiller", , Enu_ValueType_FDSP) & "              审核人：" & m_Bill.GetFieldValue("Fchecker", , Enu_ValueType_FDSP) & "                    制单日期：" & m_Bill.GetFieldValue("Fzddate")
    
    
    Set d = Nothing
    Set w = Nothing
    
End Sub

Private Function GetRows(ByVal i As Integer) As Long
    Dim vi As KFO.Vector
    Dim str As String
    str = "Page"
    Set vi = m_Bill.Data(str & CStr(i))
    GetRows = vi.Size
End Function