m_BillTransfer.BillFunc.refillbill   --刷新单据，把后台更改后的值返回前台

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

附源码：

类模块：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