bos单据插件

ylhddh

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "HYCustInformSeout"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True

'定义插件对象接口. 必须具有的声明, 以此来获得事件
Private WithEvents m_BillTransfer   As k3BillTransfer.Bill
Attribute m_BillTransfer.VB_VarHelpID = -1

Public Sub Show(ByVal oBillTransfer As Object)

    Set m_BillTransfer = oBillTransfer
    Set mdlCallIndustryBill.m_BillTransfer = m_BillTransfer

End Sub
Private Sub Class_Initialize()
    CurRow = 0
End Sub

Private Sub Class_Terminate()
    Set m_BillTransfer = Nothing
End Sub

Private Sub m_BillTransfer_BillInitialize()
    m_BillTransfer.AddUserMenuItem "客户地址(&A)", "客户地址"
End Sub


Private Sub m_BillTransfer_HeadChange(ByVal CtlIndex As Long, ByVal Value As Variant, ByVal bNewBill As Boolean, Cancel As Boolean)

Dim rs As New ADODB.Recordset
Dim cnn As ADODB.Connection
Dim strSQL As String
aa = dovalue("购货单位:")
  If (CtlIndex = aa) And Len(m_BillTransfer.GetHeadNumber(aa)) > 0 Then
       '  For intI = 1 To UBound(m_BillTransfer.HeadCtl)
        '        If UCase(m_BillTransfer.HeadCtl(intI).Caption) = UCase("地址") Then
         '           FAddNo = intI
          '          Exit For
           '     End If
         'Next
          FAddNo = dovalue("地址")

        strSQL = " Select TOP 1 客户代码,客户名称,地址代码,客户地址 From CustInfo Where 客户代码 = '" & m_BillTransfer.GetHeadNumber(aa) & "'  and isdefault=1"
        Set cnn = New ADODB.Connection
        cnn.Open m_BillTransfer.Cnnstring
        Set rs = New ADODB.Recordset
        rs.Open strSQL, cnn

        If rs.BOF = False Then

           m_BillTransfer.SetHead FAddNo, rs.Fields("地址代码")
           Else

         m_BillTransfer.SetHead FAddNo, ""
        End If
        rs.Close
        cnn.Close
  End If

End Sub

Private Sub m_BillTransfer_UserMenuClick(ByVal Index As Long, ByVal Caption As String)

      ConnectString = m_BillTransfer.Cnnstring

     'ConnectString = "ersist Security Info=Truerovider=SQLOLEDB.1;User ID=saassword=woty!21cn;Data Source=10.48.7.33;Initial Catalog=AIS20150414110546"

    Select Case Caption
    Case "客户地址(&A)"

            On Error Resume Next

            FAddNo = 0

            '确认地址所在列
            'For intI = 1 To UBound(m_BillTransfer.HeadCtl)
             '   If UCase(m_BillTransfer.HeadCtl(intI).Caption) = UCase("地址") Then
              '      FAddNo = intI
               '     Exit For
               ' End If
                'Next

              FAddNo = dovalue("地址")
             ' MsgBox FAddNo
              aa = dovalue("购货单位:")

           ' For intIi = 1 To UBound(m_BillTransfer.HeadCtl)
            ' If UCase(m_BillTransfer.HeadCtl(intIi).FieldName) = UCase("fcustid") Then
             '       aa = intIi
              '          Exit For
               ' End If
                '        Next


            If Len(m_BillTransfer.GetHeadNumber(aa)) = 0 Then

               MsgBox "请先选择客户信息"

            End If

            If Len(m_BillTransfer.GetHeadNumber(aa)) > 0 Then
               mm = m_BillTransfer.GetHeadNumber(aa) 'fcustid 位置
               Formpt.Show

            End If

    Case Else
    End Select

End Sub
Function dovalue(a As String)
For intI = 1 To UBound(m_BillTransfer.HeadCtl)
                If UCase(m_BillTransfer.HeadCtl(intI).Caption) = UCase(a) Then
                 dovalue = intI
                    Exit For
                End If
                Next
End Function

qyhua

启用邀请码注册，提高发帖质量，建设交流社区