K3 WISE 解锁整列字段（插件开发）续上篇

需求：由于表体可能几百条，都弹框取值赋值，工作量大也可能会出错，所有换了种思路

演示如下：

点击【修改单价】按钮，就会解锁【单价】和【备注】两列锁定的字段

效果如图：

然后可以进行修改单价和备注，点击【保存】按钮，重新锁定字段，并自动计算金额字段

 

附源码：

类模块：Industry_PlugIns.cls

 
'定义插件对象接口. 必须具有的声明, 以此来获得事件
Private WithEvents m_BillTransfer   As K3BillTransfer.Bill
Dim F55 As Long, F55Text As String
Dim F56 As Long, F56Text As String
Dim F57 As Long, F57Text As String
 
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_BillInitialize()
 
    'TODO: 请在此处添加代码响应事件 BillInitialize
 
 
'*************** 开始设置菜单 ***************
 
    m_BillTransfer.AddUserMenuItem "修改单价", "自定义菜单"
    m_BillTransfer.AddUserMenuItem "保存", "自定义菜单"
 
'*************** 结束设置菜单 ***************
    F55 = GetCtlIndexByFld("FEntrySelfP0132", True)
    F56 = GetCtlIndexByFld("FEntrySelfP0133", True)
    F57 = GetCtlIndexByFld("FQty", True)
  
End Sub

Private Sub m_BillTransfer_BillTerminate()
 
    'TODO: 请在此处添加代码响应事件 BillTerminate
 

End Sub

Private Sub m_BillTransfer_LeveCell(ByVal Col As Long, ByVal Row As Long, ByVal NewCol As Long, ByVal NewRow As Long, Cancel As Boolean)
 
    'TODO: 请在此处添加代码响应事件 LeveCell
    If (NewRow > 0) Then
    currow = NewRow
   End If
End Sub



Private Sub m_BillTransfer_UserMenuClick(ByVal Index As Long, ByVal Caption As String)
    Dim THeadCtl As Variant
    Dim i As Long
    Dim str As String
    Dim state As String
    Dim rs As New ADODB.Recordset
    stateCur = "False"
    'TODO: 请在此处添加代码响应事件 UserMenuClick
   
    Select Case Caption
    Case "修改单价"
     connString = m_BillTransfer.Cnnstring
         THeadCtl = m_BillTransfer.HeadCtl
        For i = 1 To UBound(THeadCtl)
            If (UCase(THeadCtl(i).FieldName) = "FBILLNO") Then
             curBillNo = m_BillTransfer.Head(i).Text
            End If
         Next
            If Len(curBillNo) > 0 Then '判断审核人
            sql = "select FMULTICHECKSTATUS from PORequest  where FBillNo='" + curBillNo + "'"
             rs.Open sql, connString, 0, 1
             state = rs.Fields(0).Value
            End If
      
        If state = 4 Then
      Dim vsEntrys As Object
'      Dim i As Long
      Set vsEntrys = m_BillTransfer.Grid
     For i = 1 To UBound(m_BillTransfer.EntryCtl)
        If UCase(m_BillTransfer.EntryCtl(i).FieldName) = "FENTRYSELFP0132" Then
        
           Exit For
       End If
        
     Next i
     With vsEntrys
        .Col = i
        .Col2 = i
        .Row = -1
        .BlockMode = True
        .Lock = False
        .BlockMode = False
     End With
         For i = 1 To UBound(m_BillTransfer.EntryCtl)
         If UCase(m_BillTransfer.EntryCtl(i).FieldName) = "FENTRYSELFP0133" Then
        
           Exit For
       End If
        
     Next i
     With vsEntrys
        .Col = i
        .Col2 = i
        .Row = -1
        .BlockMode = True
        .Lock = False
        .BlockMode = False
     End With

  Else
    MsgBox "操作失败,必须审核后才能操作！"
  End If
    Case "保存"
    Dim RowCount As Integer
    Set rs = New ADODB.Recordset

         
       RowCount = m_BillTransfer.BillForm.get_MaxEntry

       For i = 1 To RowCount
       F55Text = m_BillTransfer.GetGridText(i, F55)
       F56Text = m_BillTransfer.GetGridText(i, F56)
       F57Text = m_BillTransfer.GetGridText(i, F57)
       sql = "update PORequestentry set FEntrySelfP0133=" + Trim(Val(F56Text)) + ", FEntrySelfP0132='" + F55Text + "',FEntrySelfP0134=" + Trim(Trim(Val(F56Text)) * Trim(Val(F57Text))) + " from PORequestentry t_1 left join PORequest t_2 on t_1.FInterID=t_2.FInterID where FBillNo='" + curBillNo + "' and FEntryID=" + Trim(i)
       rs.Open sql, connString, 0, 1
       
       Next i

     
   Dim vsEntryss As Object
      Dim j As Long
      Set vsEntryss = m_BillTransfer.Grid
   For j = 1 To UBound(m_BillTransfer.EntryCtl)
        If UCase(m_BillTransfer.EntryCtl(j).FieldName) = "FENTRYSELFP0132" Then

           Exit For
       End If

     Next j
     With vsEntryss
        .Col = j
        .Col2 = j
        .Row = -1
        .BlockMode = False
        .Lock = True
        .BlockMode = True
     End With
      For j = 1 To UBound(m_BillTransfer.EntryCtl)
         If UCase(m_BillTransfer.EntryCtl(j).FieldName) = "FENTRYSELFP0133" Then

           Exit For
       End If

     Next j
     With vsEntryss
        .Col = j
        .Col2 = j
        .Row = -1
        .BlockMode = False
        .Lock = True
        .BlockMode = True
     End With
      Set rs = Nothing
    MsgBox "保存成功！"
     m_BillTransfer.BillFunc.refillbill
    End Select
    

End Sub

'**********************************
'返回单据字段顺序(isEntry True是表体)
'**********************************
Public Function GetCtlIndexByFld(ByVal fldName As String, Optional ByVal isEntry As Boolean = False) As Long
Dim ctlIdx As Long
Dim i As Integer
Dim isFind As Boolean
Dim vValue As Variant
fldName = UCase(fldName)
isFind = False
With m_BillTransfer
If isEntry Then
    For i = LBound(.EntryCtl) To UBound(.EntryCtl)
    If UCase(.EntryCtl(i).FieldName) = fldName Then
    ctlIdx = .EntryCtl(i).FCtlOrder
    isFind = True
    Exit For
    End If
    Next i
Else
    For i = LBound(.HeadCtl) To UBound(.HeadCtl)
    If UCase(.HeadCtl(i).FieldName) = fldName Then
    ctlIdx = .HeadCtl(i).FCtlIndex
    isFind = True
    Exit For
    End If
    Next i
End If
End With
If isFind = True Then
GetCtlIndexByFld = ctlIdx
Else
GetCtlIndexByFld = 0
End If
End Function

公共类：Common

  Public currow As Long
  Public curBillNo As String
  Public connString As String
  Public stateCur As String