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