新增替换删除模块的部分代码的函数

时　间:2016-12-19 12:43:28
作　者:MDZZ   ID：47512  城市：南京
摘　要:新增替换删除模块的部分代码
正　文:

给大家分享模块里面新增替换删除代码的函数

调用示例   Call InsertWholeLine("Module1", "Const conPi = 3.14", "Const conPi = 3.33")

Function DeleteWholeLine(strModuleName, strText As String) _
     As Boolean
     Dim mdl As Module, lngNumLines As Long
     Dim lngSLine As Long, lngSCol As Long
     Dim lngELine As Long, lngECol As Long
     Dim strTemp As String
     On Error GoTo Error_DeleteWholeLine
     DoCmd.OpenModule strModuleName
     Set mdl = Modules(strModuleName)
     If mdl.Find(strText, lngSLine, lngSCol, lngELine, lngECol) Then
         lngNumLines = Abs(lngELine - lngSLine) + 1
         strTemp = LTrim$(mdl.Lines(lngSLine, lngNumLines))
         strTemp = RTrim$(strTemp)
         If strTemp = strText Then
             mdl.DeleteLines lngSLine, lngNumLines
             Else
             MsgBox "Line contains text in addition to '" _
                 & strText & "'."
         End If
     Else
         MsgBox "内容 '" & strText & "' 未找到."
     End If
     DeleteWholeLine = True
 Exit_DeleteWholeLine:
     Exit Function
 Error_DeleteWholeLine:
     MsgBox Err & " :" & Err.Description
     DeleteWholeLine = False
     Resume Exit_DeleteWholeLine
 End Function

Function ReplaceWholeLine(strModuleName, strText As String, strText1 As String) _
      As Boolean
     Dim mdl As Module, lngNumLines As Long
     Dim lngSLine As Long, lngSCol As Long
     Dim lngELine As Long, lngECol As Long
     Dim strTemp As String
     On Error GoTo Error_ReplaceWholeLine
     DoCmd.OpenModule strModuleName
     Set mdl = Modules(strModuleName)
     If mdl.Find(strText, lngSLine, lngSCol, lngELine, lngECol) Then
         lngNumLines = Abs(lngELine - lngSLine) + 1
         strTemp = LTrim$(mdl.Lines(lngSLine, lngNumLines))
         strTemp = RTrim$(strTemp)
         If strTemp = strText Then
             mdl.ReplaceLine lngSLine, strText1
             Else
             MsgBox "Line contains text in addition to '" _
                 & strText & "'."
         End If
     Else
         MsgBox "内容 '" & strText & "' 未找到."
     End If
     ReplaceWholeLine = True
 Exit_ReplaceWholeLine:
     Exit Function
 Error_ReplaceWholeLine:
     MsgBox Err & " :" & Err.Description
     ReplaceWholeLine = False
     Resume Exit_ReplaceWholeLine
 End Function

Function InsertWholeLine(strModuleName, strText As String, strText1 As String) _
      As Boolean
     Dim mdl As Module, lngNumLines As Long
     Dim lngSLine As Long, lngSCol As Long
     Dim lngELine As Long, lngECol As Long
     Dim strTemp As String
     On Error GoTo Error_InsertWholeLine
 '    DoCmd.OpenModule strModuleName
     Set mdl = Modules(strModuleName)
     If mdl.Find(strText, lngSLine, lngSCol, lngELine, lngECol) Then
         lngNumLines = Abs(lngELine - lngSLine) + 1
         strTemp = LTrim$(mdl.Lines(lngSLine, lngNumLines))
         strTemp = RTrim$(strTemp)
         If strTemp = strText Then
             mdl.InsertLines lngSLine + 1, strText1
             Else
             MsgBox "Line contains text in addition to '" _
                 & strText & "'."
         End If
     Else
         MsgBox "内容 '" & strText & "' 未找到."
     End If
     InsertWholeLine = True
 Exit_InsertWholeLine:
     Exit Function
 Error_InsertWholeLine:
     MsgBox Err & " :" & Err.Description
     InsertWholeLine = False
     Resume Exit_InsertWholeLine

End Function

    以上只适用于标准模块和类模块   改成窗体的 大致如下   有兴趣自己在修改下  

Private Sub Command0_Click()
  Call InsertWholeLine(Form_窗体2.Form.Module, "Const conPi = 3.14", "Const conPi = 3.33")
     
 End Sub


 Function InsertWholeLine(frm, strText As String, strText1 As String) _
      As Boolean
    Dim mdl As Module
     Dim lngNumLines As Long
     Dim lngSLine As Long, lngSCol As Long
     Dim lngELine As Long, lngECol As Long
     Dim strTemp As String
     
    Set mdl = frm
     If mdl.Find(strText, lngSLine, lngSCol, lngELine, lngECol) Then
         lngNumLines = Abs(lngELine - lngSLine) + 1
         strTemp = LTrim$(mdl.Lines(lngSLine, lngNumLines))
         strTemp = RTrim$(strTemp)
         If strTemp = strText Then
             mdl.InsertLines lngSLine + 1, strText1
             Else
             MsgBox "Line contains text in addition to '" _
                 & strText & "'."
         End If
     Else
         MsgBox "内容 '" & strText & "' 未找到."
     End If
     InsertWholeLine = True
 Exit_InsertWholeLine:
     Exit Function
 Error_InsertWholeLine:
     MsgBox Err & " :" & Err.Description
     InsertWholeLine = False
     Resume Exit_InsertWholeLine


 End Function
 Function DeleteWholeLine(frm, strText As String) _
      As Boolean
     Dim mdl As Module, lngNumLines As Long
     Dim lngSLine As Long, lngSCol As Long
     Dim lngELine As Long, lngECol As Long
     Dim strTemp As String
     On Error GoTo Error_DeleteWholeLine
    Set mdl = frm
     If mdl.Find(strText, lngSLine, lngSCol, lngELine, lngECol) Then
         lngNumLines = Abs(lngELine - lngSLine) + 1
         strTemp = LTrim$(mdl.Lines(lngSLine, lngNumLines))
         strTemp = RTrim$(strTemp)
         If strTemp = strText Then
             mdl.DeleteLines lngSLine, lngNumLines
             Else
             MsgBox "Line contains text in addition to '" _
                 & strText & "'."
         End If
     Else
         MsgBox "内容 '" & strText & "' 未找到."
     End If
     DeleteWholeLine = True
 Exit_DeleteWholeLine:
     Exit Function
 Error_DeleteWholeLine:
     MsgBox Err & " :" & Err.Description
     DeleteWholeLine = False
     Resume Exit_DeleteWholeLine
 End Function


 Function ReplaceWholeLine(frm, strText As String, strText1 As String) _
      As Boolean
     Dim mdl As Module, lngNumLines As Long
     Dim lngSLine As Long, lngSCol As Long
     Dim lngELine As Long, lngECol As Long
     Dim strTemp As String
     On Error GoTo Error_ReplaceWholeLine
     Set mdl = frm
     If mdl.Find(strText, lngSLine, lngSCol, lngELine, lngECol) Then
         lngNumLines = Abs(lngELine - lngSLine) + 1
         strTemp = LTrim$(mdl.Lines(lngSLine, lngNumLines))
         strTemp = RTrim$(strTemp)
         If strTemp = strText Then
             mdl.ReplaceLine lngSLine, strText1
             Else
             MsgBox "Line contains text in addition to '" _
                 & strText & "'."
         End If
     Else
         MsgBox "内容 '" & strText & "' 未找到."
     End If
     ReplaceWholeLine = True
 Exit_ReplaceWholeLine:
     Exit Function
 Error_ReplaceWholeLine:
     MsgBox Err & " :" & Err.Description
     ReplaceWholeLine = False
     Resume Exit_ReplaceWholeLine
 End Function