在上次实现用Grid++Repot报表实现打印任务单后，在想着能不能给将生产任务单原来要通过点击菜单栏，打印任务单的功能，在工具栏上也增加按钮实现，这样就不需要多点了。
原本是需要点击菜单栏才能实现的

现在在工具栏上增加按钮实现同一功能

通过参考金蝶KIS旗舰版7.0工业单据(老单)表单工具栏插入按钮

先新建类模块

代码如下

'生产任务单（工业老单）增加工具栏按钮，并引用锐浪报表
'定义插件对象接口. 必须具有的声明, 以此来获得事件
Private WithEvents m_BillTransfer   As k3BillTransfer.Bill

Public Sub Show(ByVal oBillTransfer As Object) 
    '接口实现
    '注意: 此方法必须存在, 请勿修改
    Set m_BillTransfer = oBillTransfer
End Sub


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

End Sub

Private Sub m_BillTransfer_LoadBillEnd(ByVal ShowType As Long)
' MsgBox "点击成功"
 On Error Resume Next
    With m_BillTransfer.BillForm.tlbTool.Buttons
    '如果还要加按钮，就增加一行.Add.Count,Count - 1指最后一个图标的前一个位置；最后的数字是图标的编号，可任意。
        .Add .Count - 1, "BtnIn", "流程卡", , 10
        .Add .Count - 1, "BtnCod", "条码", , 20
    End With
   
End Sub
Private Sub m_BillTransfer_RetEvents(ByVal Para As KFO.IDictionary)
 
    'TODO: 请在此处添加代码响应事件 RetEvents
Dim Report As GridppReport
Set Report = New GridppReport

 
If Not Para Is Nothing Then
  If Para.GetValue("EventID", 0) = "Bill_ButtonClick" Then
    If Para.GetValue("EventIDprop", 0) = "0" Then
    
      If Para("Para")("Button").Key = "BtnIn" Then
'        MsgBox "测试成功"
        Report.LoadFromFile ("\\192.168.100.3\Gird Report\流转卡.grf")
        Report.DetailGrid.Recordset.ConnectionString = m_BillTransfer.Cnnstring
        Report.DetailGrid.Recordset.QuerySQL = "exec jlkj_dyh_Gird_工序流程卡打印 '" & m_BillTransfer.GetHeadText(GetHeadIndex("FInterID", 1)) & "'"
        Report.PrintPreview (True)
      ElseIf Para("Para")("Button").Key = "BtnCod" Then
        Report.LoadFromFile ("\\\192.168.100.3\Gird Report\任务条码.grf")
        Report.Printer.PrinterName = "Microsoft Print to PDF" '指定打印机
        Report.DetailGrid.Recordset.ConnectionString = m_BillTransfer.Cnnstring
        Report.DetailGrid.Recordset.QuerySQL = "exec jlkj_dyh_Gird_工序流程卡打印 '" & m_BillTransfer.GetHeadText(GetHeadIndex("FInterID", 1)) & "'"
        Report.[Print] (True) '不预览直接打印。加[]是为了避免与VB的print函数混掉
      End If
     
    End If
  End If
End If

End Sub



'返回字段索引值函数
Private Function GetHeadIndex(ByVal ColHead As String, Optional iField As Long = 0) As Long
    On Error Resume Next
    Dim i As Long
    For i = 1 To UBound(m_BillTransfer.HeadCtl)
        If (m_BillTransfer.HeadCtl(i).Caption = ColHead And iField = 0) Or (LCase(m_BillTransfer.HeadCtl(i).FieldName) = LCase(ColHead) And iField = 1) Then
            GetHeadIndex = i
            Exit For
        End If
    Next
End Function

生成好DLL后，用命令行regsvr32注册，并且在BOS工具的插件管理中选择DLL及对应的类模块