Excel 实战

最新推荐文章于 2023-09-01 16:17:21 发布
最新推荐文章于 2023-09-01 16:17:21 发布
阅读量492 收藏
点赞数 1
分类专栏： Excel VB 技巧
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/moscot_wu/article/details/96320117
版权 
Sub Findblankrange(str As String, end_row As Integer, start_row As Integer)
    Dim rng
    'Dim i As Integer
    'Dim lr As Integer
   ' On Error Resume Next
'lr = ActiveSheet.UsedRange.Rows.Count
Set rng = ActiveSheet.UsedRange.Find(str)
start_row = rng.row
'MsgBox start_row
end_row = ActiveSheet.Range("A" & start_row).End(xlDown).row + 1 'the first blank after
'MsgBox end_row
'For i = start_row To lr + 1
'If Application.WorksheetFunction.CountA(Rows(i)) = 0 Then
'end_row = i
'Exit For
'End If
'Next i
End Sub

Sub Findfirstblankrow(rown As Integer)
    Dim i As Integer
    On Error Resume Next
For i = 28 To 58
'Set myRange = Worksheets("Input Form").Range("A" & i & ":G" & i)
If Application.WorksheetFunction.CountA(Rows(i)) = 0 Then
rown = i
'MsgBox "No Value, in " & rown
Exit For
End If
Next
End Sub
Sub Findsecondblankrow(spe_row As Integer, n As Integer)
    Dim k As Integer
    Dim m As Integer
    On Error Resume Next
For k = 31 To 71
If ActiveSheet.Range("A" & k) = "REFER_CTRY_REPORTS_REL" Then
n = k + 1
For m = n To n + 40
If Application.WorksheetFunction.CountA(Rows(m)) = 0 Then
spe_row = m
Exit For
End If
Next m

Exit For
End If
Next k
End Sub

Sub Findthirdblankrow(spe_row As Integer, n As Integer)
    Dim k As Integer
    Dim m As Integer
    On Error Resume Next
For k = 34 To 74
If ActiveSheet.Range("A" & k) = "REFER_CTRY_FF_REPORTS_REL" Then
n = k + 1
For m = n To n + 40
If Application.WorksheetFunction.CountA(Rows(m)) = 0 Then
spe_row = m
Exit For
End If
Next m
Exit For
End If
Next k
End Sub

'This is copy and past value only
Sub past()
Dim row_1 As Integer
row_1 = Sheets("REFER_REPORTS").UsedRange.Rows.Count + 1
    Worksheets("Input Form").Range("A26:M26").Copy
    Worksheets("REFER_REPORTS").Range("A" & row_1).PasteSpecial (xlPasteValues)
    Application.CutCopyMode = xlCut
End Sub
Sub past5()
Dim row_1 As Integer
row_1 = Sheets("REFER_REPORTS").UsedRange.Rows.Count + 1
    Worksheets("Input Form").Range("A27:M27").Copy
    Worksheets("REFER_REPORTS").Range("A" & row_1).PasteSpecial (xlPasteValues)
    Application.CutCopyMode = xlCut
End Sub

Sub past2()
Dim row_2 As Integer
Dim ft As Integer
row_2 = Sheets("RPT_ELEM_REL").UsedRange.Rows.Count + 1
Call Findfirstblankrow(ft)
Worksheets("Input Form").Range("A31:F" & ft - 1).Copy
Worksheets("RPT_ELEM_REL").Range("A" & Rows.Count + 1).PasteSpecial (xlPasteValues)
Application.CutCopyMode = xlCut
End Sub

Sub past3()
Dim row_3 As Integer
Dim k As Integer
Dim m As Integer
row_3 = Sheets("REFER_CTRY_REPORTS_REL").UsedRange.Rows.Count + 1
Call Findsecondblankrow(m, k)
Worksheets("Input Form").Range("A" & k + 1 & ":E" & m - 1).Copy
Worksheets("REFER_CTRY_REPORTS_REL").Range("A" & row_3).PasteSpecial (xlPasteValues)
Application.CutCopyMode = xlCut
End Sub
Sub past4()
Dim row_4 As Integer
Dim k As Integer
Dim m As Integer
row_4 = Sheets("REFER_CTRY_FF_REPORTS_REL").UsedRange.Rows.Count + 1
Call Findthirdblankrow(m, k)
Worksheets("Input Form").Range("A" & k + 1 & ":F" & m - 1).Copy
Worksheets("REFER_CTRY_FF_REPORTS_REL").Range("A" & row_4).PasteSpecial (xlPasteValues)
Application.CutCopyMode = xlCut
End Sub
Sub Alloff()
Dim i As Integer
For i = 1 To 27
ActiveSheet.OLEObjects("CheckBox" & i).Object.Value = 0
Next
ActiveSheet.OLEObjects("CheckBox93").Object.Value = 0
ActiveSheet.OLEObjects("CheckBox94").Object.Value = 0
End Sub
Sub Allon()
Dim i As Integer
For i = 1 To 27
ActiveSheet.OLEObjects("CheckBox" & i).Object.Value = 1
Next
ActiveSheet.OLEObjects("CheckBox93").Object.Value = 1
ActiveSheet.OLEObjects("CheckBox94").Object.Value = 1
End Sub

Sub Addnewline2(st As String, n As Integer)
'Updateby Extendoffcie 20161129
    Dim Response
    Dim str As String
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Input Form")
    Response = vbYes
    'MsgBox Response
    Do While Response = vbYes
    If Response = vbYes Then
    str = InputBox("Please input BIS_TRAN_FILE_FORMT_CD.", "BIS_TRAN_FILE_FORMT_CD")
    With ws
    .Range("A" & n).EntireRow.Insert
    .Range("A" & n) = "N/A"
    .Range("A" & n & ":B" & n).Merge
    .Range("C" & n) = st
    .Range("D" & n) = str
    .Range("D" & n & ":E" & n).Merge
    .Range("F" & n).Formula = "=E3"
    End With
    'Response = MsgBox("Do you want add new one?", vbYesNo, "Add new ")
    End If
    Response = MsgBox("Do you want to add a new one?", vbYesNo, "Add new one")
    Loop
End Sub

'Cancel all selected CheckBox
Sub clearcheckbox()
'Updateby Extendoffcie 20161129
    Dim c As Object
    For Each c In ActiveSheet.OLEObjects
        If InStr(1, c.Name, "CheckBox") > 0 Then
            c.Object.Value = False
        End If
    Next
End Sub

Sub Addnewline(st As String, n As Integer)

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Input Form")
    'MsgBox Response
    'Call Findfirstblankrow(n)
    With ws
    .Range("A" & n).EntireRow.Insert
    .Range("A" & n) = "N/A"
    .Range("B" & n).Formula = "=E2"
    .Range("C" & n) = st
    .Range("C" & n & ":D" & n).Merge
    .Range("E" & n) = ""
    .Range("F" & n).Formula = "=E21"
    .Range("F" & n & ":G" & n).Merge
    End With
End Sub

Sub Addnewline1(st As String, n As Integer)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Input Form")
    'MsgBox Response
    'Call Findfirstblankrow(n)
    With ws
    .Range("A" & n).EntireRow.Insert
    .Range("A" & n) = "N/A"
    .Range("A" & n & ":B" & n).Merge
    .Range("C" & n) = st
    .Range("D" & n).Formula = "=E9"
    .Range("E" & n).Formula = "=E3"
    End With
End Sub

Sub Delline(st As String, n As Integer, m As Integer)
'Updateby Extendoffcie 20161129
    Dim Response
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Input Form")
    'Dim m As Integer
    'Dim n As Integer
    'Call Findthirdblankrow(n, m)
    'MsgBox m & n
    For i = n To m Step -1
    If ws.Range("C" & i) = st Then
    ws.Range("A" & i + 1).Offset(-1, 0).EntireRow.Delete
    End If
    Next
End Sub

Function lastline(str As String) As Integer
'Updateby Extendoffcie 20161129
    Dim n As Integer
    n = Sheet(str).UsedRange.Rows.Count
    lastline = n
End Function

Sub Findstr(str As String, k As Integer)
k = ActiveSheet.UsedRange.Find(str).row
MsgBox k
End Sub


'Sub GetOption()
'Dim x As Integer, i As Integer
'Dim TempForm As Access.Module
'Set objModule = Application.Modules.Item(Application.VBE.ActiveCodePane.CodeModule.Parent.Name)
'Dim WSheet As Worksheet
'With ActiveSheet.CheckBox
'For i = 98 To 99
'With TempForm.CodeModule
'x = .CountOfLines
'.InsertLines x + 1, "Private Sub CheckBox" & i & "_Click()"
'.InsertLines x + 2, " Dim n As Integer,st As String"
'.InsertLines x + 3, " st = Me.CheckBox" & i & ".Caption"
'.InsertLines x + 4, " With Me.CheckBox" & i
'.InsertLines x + 5, " Call Findfirstblankrow(n)"
'.InsertLines x + 6, " .Value Then"
'.InsertLines x + 7, " Me.Range(""A"" & n).EntireRow.Insert"
'.InsertLines x + 8, " Me.Range(""A"" & n) = ""N/A"""
'.InsertLines x + 9, " Me.Range(""B"" & n) = Me.Range(""E2"")"
'.InsertLines x + 10, " Me.Range(""C"" & n) = st"
'.InsertLines x + 11, " Me.Range(""C"" & n & "":D"" & n).Merge"
'.InsertLines x + 12, "Me.Range(""E"" & n) = """""
'.InsertLines x + 13, " Me.Range(""F"" & n) = Cells(21, 5)"
'.InsertLines x + 14, " Me.Range(""F"" & n & "":G"" & n).Merge"
'.InsertLines x + 15, " Else"
'.InsertLines x + 16, " For i = 28 To n"
'.InsertLines x + 17, " If Me.Range(""C"" & i) = st Then"
'.InsertLines x + 18, " Me.Range(""A"" & i + 1).Offset(-1, 0).EntireRow.Delete"
'.InsertLines x + 19, " End If"
'.InsertLines x + 20, " Next"
'.InsertLines x + 21, "End If"
'.InsertLines x + 22, " End With"
'.InsertLines x + 23, "End Sub"
'End With
'Next i
'End Sub
Function FindAll(ByVal rng As Range, ByVal searchTxt As String) As Range
    Dim foundCell As Range
    Dim firstAddress
    Dim rResult As Range
    With rng
        Set foundCell = .Find(What:=searchTxt, _
                              After:=.Cells(.Cells.Count), _
                              LookIn:=xlValues, _
                              LookAt:=xlWhole, _
                              SearchOrder:=xlByRows, _
                              SearchDirection:=xlNext, _
                              MatchCase:=False)
        If Not foundCell Is Nothing Then
            firstAddress = foundCell.Address
            Do
                If rResult Is Nothing Then
                    Set rResult = foundCell
                Else
                    Set rResult = Union(rResult, foundCell)
                End If
                Set foundCell = .FindNext(foundCell)
            Loop While Not foundCell Is Nothing And foundCell.Address <> firstAddress
        End If
    End With

    Set FindAll = rResult
End Function

Sub copy_elem()
Dim rng1, rng2, rng3 As Range, addr$, adr$
Dim wt1, wt2 As Worksheet
Dim str As String
Set wt1 = Worksheets("Input Form")
Set wt2 = Worksheets("RPT_ELEM_REL")
str = wt1.Range("A27").Value
With wt2.Range("B:B")
Set rng1 = .Find(str, LookAt:=1)
addr = rng1.Address
Do
Set rng1 = .FindNext(rng1)
adr = rng1.Address
'ToggleButton1.Value = True
'ToggleButton1.Value = False
Set rng2 = wt1.Range("A31")
Set rng3 = rng1.EntireRow.Range("a1:m1")
rng3.Copy
rng2.Insert Shift:=xlDown
Loop Until addr = rng1.Address
End With
End Sub

Sub copy_tab(str As String, tname As String, rowf As String, n As Integer)
Dim rng1, rng2, rng3 As Range, addr$, adr$
Dim wt1, wt2 As Worksheet
Set wt1 = Worksheets("Input Form")
Set wt2 = Worksheets(tname)
With wt2.Range(rowf)
Set rng1 = .Find(str, LookAt:=1)
addr = rng1.Address
If rng1.row <> 0 And rng1.Value <> "" Then
Do
Set rng1 = .FindNext(rng1)
adr = rng1.Address
Set rng2 = wt1.Range("A" & n)
Set rng3 = rng1.EntireRow.Range("a1:m1")
rng3.Copy
rng2.Insert Shift:=xlDown
Loop Until addr = rng1.Address
End If
End With
End Sub

Sub DelRange(str As String)
Dim n As Integer
Dim m As Integer
Dim rng As Range
Dim wt As Worksheet
Set wt = Worksheets("Input Form")
Call Findblankrange(str, n, m)
If m + 2 = n Then
'MsgBox "No need to delete."
Else
wt.Range("A" & m + 2 & ":M" & n - 1).EntireRow.Delete
End If
End Sub

Sub DelRecords(tname As String, str As String, rown As String)
Dim rng1 As Range
', addr$, adr$
'Dim n As Integer
Dim wt1 As Worksheet
'On Error Resume Next
Set wt1 = Worksheets(tname)
With wt1.Range(rown)
Set rng1 = .Find(str, LookAt:=1)
If Not rng1 Is Nothing Then
'addr = rng1.Address
Do
'n = rng1.row
'MsgBox n
rng1.EntireRow.Delete
Set rng1 = .FindNext()  'findnex can no parameter
Loop While Not rng1 Is Nothing 'And addr <> rng1.Address
End If
End With
End Sub

Sub copy_range(tname As String, n As Integer, m As Integer)
Dim rng1, rng2, rng3 As Range
Dim end_row As Integer
Dim wt1, wt2 As Worksheet
Set wt1 = Worksheets("Input Form")
Set wt2 = Worksheets(tname)
end_row = wt2.UsedRange.Rows.Count + 1
'MsgBox m + 2 & "||" & n - 1
With wt1
Set rng1 = .Range("A" & m + 2 & ":M" & n - 1)
'end_row = wt2.Range("A" & end_row).End(xlDown).row + 1
'MsgBox end_row
Set rng2 = wt2.Range("A" & end_row)
rng1.Copy
rng2.PasteSpecial (xlPasteValues)
Application.CutCopyMode = xlCut
End With
End Sub

以上是module 部分

 

以下是功能键

Private Sub CheckBox1_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox1
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox10_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox10
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox11_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox11
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox12_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox12
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox13_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox13
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox14_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox14
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox15_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox15
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox16_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox16
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox17_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox17
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox18_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox18
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox19_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox19
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox2_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox2
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox20_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox20
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox21_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox21
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox22_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox22
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox23_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox23
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox24_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox24
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox25_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox25
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox26_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox26
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox27_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox27
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox28_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox28
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox29_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox29
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox3_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox3
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox30_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox30
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox31_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox31
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox32_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox32
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox33_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox33
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox34_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox34
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox35_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox35
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox36_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox36
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox37_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox37
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox38_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox38
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox39_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox39
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox4_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox4
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox40_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox40
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox41_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox41
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox42_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox42
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox43_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox43
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox44_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox44
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox45_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox45
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox46_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox46
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox47_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox47
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox48_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox48
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox49_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox49
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox5_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox5
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox50_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox50
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox51_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox51
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox52_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox52
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox53_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String ' the table name
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox53
st = .Caption
Call Findblankrange(tname, n, m)
'MsgBox m
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox54_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox54
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox55_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox55
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox56_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox56
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox57_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox57
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox58_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox58
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox59_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox59
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox6_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox6
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox60_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox60
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox61_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox61
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox62_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox62
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox63_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox63
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox64_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox64
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox65_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox65
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox66_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox66
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox67_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox67
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox68_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox68
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox69_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox69
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox7_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox7
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox70_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox70
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox71_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox71
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox72_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox72
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox73_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox73
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox74_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox74
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox75_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox75
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox76_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox76
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox77_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox77
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox78_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox78
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox79_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String ' the table name
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox79
st = .Caption
Call Findblankrange(tname, n, m)
'MsgBox m
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox8_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox8
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox80_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox80
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox81_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox81
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox82_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox82
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox83_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox83
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox84_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox84
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox85_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox85
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox86_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox86
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox87_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox87
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox88_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox88
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox89_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox89
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox9_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox9
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

Private Sub CheckBox90_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_FF_REPORTS_REL"
With Me.CheckBox90
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline2(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox91_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox91
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox92_Click()
Dim n As Integer
Dim m As Integer
Dim tname As String
Dim st As String
Application.ScreenUpdating = False
tname = "REFER_CTRY_REPORTS_REL"
With Me.CheckBox92
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline1(st, n)
Else
Call Delline(st, n, m)
End If
End With
Application.ScreenUpdating = True
End Sub

Private Sub CheckBox93_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox93
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub


Private Sub CheckBox94_Click()
Dim n As Integer ' first row number of the blank
Dim m As Integer ' start row number of the table
Dim tname As String ' the table name
Dim st As String  'button caption
tname = "RPT_ELEM_REL"
With Me.CheckBox94
st = .Caption
Call Findblankrange(tname, n, m)
If .Value Then
Call Addnewline(st, n)
Else
Call Delline(st, n, m)
End If
End With
End Sub

'This is the submit button.
Private Sub CommandButton1_Click()
'On Error Resume Next
Dim row_1 As Integer
row_1 = Sheets("REFER_REPORTS").UsedRange.Rows.Count + 1
Dim row_2 As Integer
row_2 = Sheets("RPT_ELEM_REL").UsedRange.Rows.Count + 1
Dim str_1 As String

Dim rn As Integer
 
rn = Worksheets("REFER_REPORTS").Range("A" & row_1 - 1).Value + 1
If rn < 20000 Then
rn = 20000
End If

Sheets("Input Form").Range("E2").Value = rn
Label1.Caption = rn
If vbOK = MsgBox("Confirm Submission", vbOKCancel, "prompt") Then
Application.ScreenUpdating = False
Dim st1 As String
Dim st2 As Range
Dim ft As Integer
st1 = Worksheets("Input Form").Range("E3").Value
Set st2 = Worksheets("REFER_REPORTS").Range("B2:B" & row_1)
If Application.WorksheetFunction.CountIf(st2, st1) = 0 Then

Call past

'Call past2
Dim tname2 As String
Dim er2 As Integer
Dim sr2 As Integer
tname2 = "RPT_ELEM_REL"
Call Findblankrange(tname2, er2, sr2)
Call copy_range(tname2, er2, sr2)

Call past3

Call past4

MsgBox "Submit completed."
Label1.Caption = Worksheets("REFER_REPORTS").Range("A" & row_1).Value + 1
Sheets("Input Form").Range("E2").Value = Label1.Caption
Worksheets("Input Form").Activate
'Call clearcheckbox
  Else
     MsgBox "RPT_ID Duplicate,Please Amend."
     Worksheets("Input Form").Activate
End If
Else
  MsgBox "Cancel Submission."
  Call clearcheckbox
Dim tname11 As String
Dim tname22 As String
Dim tname33 As String
tname11 = "RPT_ELEM_REL"
tname22 = "REFER_CTRY_REPORTS_REL"
tname33 = "REFER_CTRY_FF_REPORTS_REL"
Call DelRange(tname11)
Call DelRange(tname22)
Call DelRange(tname33)
End If
Application.ScreenUpdating = True
End Sub
'this is the query button
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Call clearcheckbox
Dim tname1 As String
Dim tname2 As String
Dim tname3 As String
tname1 = "RPT_ELEM_REL"
tname2 = "REFER_CTRY_REPORTS_REL"
tname3 = "REFER_CTRY_FF_REPORTS_REL"
Call DelRange(tname1)
Call DelRange(tname2)
Call DelRange(tname3)


    Dim rng1, rng2, rng3 As Range
    Dim n As Integer
    Dim str As String
    Dim wt1, wt2 As Worksheet
    Set wt1 = Worksheets("Input Form")
    Set wt2 = Worksheets("REFER_REPORTS")
    wt1.Range("A27:M27").ClearContents
    str = InputBox("Please input your RPT_ID.", "RPT_ID")
    On Error Resume Next
    'n = wt2.Range("B:B").Find(str, LookAt:=1).Row
    With wt2.Range("B:B")
    Set rng1 = .Find(str, LookAt:=1)
    Set rng2 = wt1.Range("A27")
    n = rng1.row
    If n = 0 Then
    MsgBox "Can't find your RPT_ID."
    ElseIf str = "" Then
    'MsgBox "User Cancel."
    Else
    wt1.Range("E3").Value = UCase(str)
    wt1.Range("E2").Value = rng2.Value
    
    Set rng3 = rng1.EntireRow.Range("a1:m1")
    rng3.Copy
    rng2.PasteSpecial (xlPasteValues) 'no need format only value
    Application.CutCopyMode = xlCut
    wt1.Range("E2").Value = wt1.Range("A27").Value 'set report number
    Label1.Value = True
    
    '''RPT_ELEM_REL
    Dim en1 As Integer
    Dim st1 As Integer
    Dim str1 As String
    Dim rowstr1 As String
    str1 = wt1.Range("A27").Value
    rowstr1 = "B:B"
    Call Findblankrange(tname1, en1, st1)
    Call copy_tab(str1, tname1, rowstr1, en1)
    'Call copy_elem  ' can be replaced by copy_tab
    
    'next copy REFER_CTRY_REPORTS_REL
    Dim en2 As Integer
    Dim st2 As Integer
    Dim str2 As String
    Dim rowstr2 As String
    str2 = wt1.Range("B27").Value
    rowstr2 = "E:E"
   ' Dim en, st As Integer
    Call Findblankrange(tname2, en2, st2)
    Call copy_tab(str2, tname2, rowstr2, en2)
    '''''copy REFER_CTRY_FF_REPORTS_REL
    Dim en3 As Integer
    Dim st3 As Integer
    'Dim str3 As String
    Dim rowstr3 As String
    'str3 = wt1.Range("B27").Value
    rowstr3 = "F:F"
   ' Dim en, st As Integer
    Call Findblankrange(tname3, en3, st3)
    Call copy_tab(str2, tname3, rowstr3, en3)
    End If
End With
 Application.ScreenUpdating = True

End Sub
'This is the modify button.
Private Sub CommandButton3_Click()
'1 query
'2 delete
'3 submit
Application.ScreenUpdating = False
Dim str As String
Dim str1 As String
Dim str2 As String
Dim str3 As String
Dim str4 As String
Dim row1 As String
Dim row2 As String
Dim row3 As String
Dim row4 As String
Dim tname As String
tname = "Input Form"
Dim tname1 As String
Dim tname2 As String
Dim tname3 As String
Dim tname4 As String
Dim wt1 As Worksheet
Set wt1 = Worksheets(tname)
tname1 = "REFER_REPORTS"
tname2 = "RPT_ELEM_REL"
tname3 = "REFER_CTRY_REPORTS_REL"
tname4 = "REFER_CTRY_FF_REPORTS_REL"
Dim er1 As Integer
Dim er2 As Integer
Dim er3 As Integer
Dim er4 As Integer
Dim sr1 As Integer
Dim sr2 As Integer
Dim sr3 As Integer
Dim sr4 As Integer
str1 = wt1.Range("E3").Value
str2 = wt1.Range("A27").Value
str = wt1.Range("B27").Value
str3 = str1
str4 = str1
row1 = "B:B"
row2 = "B:B"
row3 = "E:E"
row4 = "F:F"

MsgBox "Modify need to query first then delete the exist records ,finally submit the modified records."
'CommandButton2 = True
If str2 <> "" Then

If vbOK = MsgBox("Really want to delete these records?", vbOKCancel, "prompt") Then

'Call DelRecords(tname, str, row1)

Call DelRecords(tname1, str1, row1)

Call DelRecords(tname2, str2, row2)

Call DelRecords(tname3, str3, row3)

Call DelRecords(tname4, str4, row4)
MsgBox "Delete Completed."

If vbOK = MsgBox("Really want to Modify these records?", vbOKCancel, "prompt") Then


'REFER_REPORTS
Call past
'Call Findblankrange(tname1, er1, sr1)
'Call copy_range(tname1, er1, sr1)

'RPT_ELEM_REL
Call Findblankrange(tname2, er2, sr2)
Call copy_range(tname2, er2, sr2)

'REFER_CTRY_REPORTS_REL
Call Findblankrange(tname3, er3, sr3)
Call copy_range(tname3, er3, sr3)

'REFER_CTRY_FF_REPORTS_REL
Call Findblankrange(tname4, er4, sr4)
Call copy_range(tname4, er4, sr4)
MsgBox "Modify success."
Else
MsgBox "Cancel modify Success."
End If
Else
MsgBox "Cancel delete success."
End If
Else
MsgBox "Can't find the report id,please query first!"
End If
Application.ScreenUpdating = True
End Sub
'This is the delete button.
Private Sub CommandButton4_Click()
CommandButton2 = True 'first display all data
Dim str1 As String
Dim str2 As String
Dim str3 As String
Dim str4 As String
Dim row1 As String
Dim row2 As String
Dim row3 As String
Dim row4 As String
Dim tname1 As String
Dim tname2 As String
Dim tname3 As String
Dim tname4 As String
Dim wt1 As Worksheet
tname1 = "REFER_REPORTS"
tname2 = "RPT_ELEM_REL"
tname3 = "REFER_CTRY_REPORTS_REL"
tname4 = "REFER_CTRY_FF_REPORTS_REL"
Set wt1 = Worksheets("Input Form")
Application.ScreenUpdating = False
tname1 = "REFER_REPORTS"
str1 = wt1.Range("E3").Value
str2 = wt1.Range("A27").Value
str3 = str1
str4 = str1
row1 = "B:B"
row2 = "B:B"
row3 = "E:E"
row4 = "F:F"
If str2 <> "" Then
wt1.Range("E2").Value = str2
If vbOK = MsgBox("Really want to delete these records?", vbOKCancel, "prompt") Then
'MsgBox str2
'Worksheets(tname1).Active
Call DelRecords(tname1, str1, row1)
 'Worksheets(tname2).Active
'If str2 <> "" Then
Call DelRecords(tname2, str2, row2)
'End If
 'Worksheets(tname3).Active
Call DelRecords(tname3, str3, row3)
 'Worksheets(tname4).Active
Call DelRecords(tname4, str4, row4)
MsgBox "Delete Completed."
Else
MsgBox "Cancel Success."
End If
Else
MsgBox "Please click query first"
End If
 Application.ScreenUpdating = True
End Sub

Private Sub Label1_Click()
MsgBox ">_< Easter Egg!^_^!" & Me.OLEObjects.Count
Label1.Caption = Sheets("Input Form").Range("E2").Value
End Sub

Private Sub ToggleButton1_Click()
Application.ScreenUpdating = False
With ToggleButton1
If .Value = True Then
    .Caption = "All OFF"
Call Allon
Else
    .Caption = "All ON"
Call Alloff
End If
End With
Application.ScreenUpdating = True
End Sub

 

moscot_wu
关注
  • 1
    点赞
  • 踩
  • 0
    收藏
    觉得还不错? 一键收藏
  • 1
    评论
专栏目录
Excel实战技巧精粹.rar
09-06
电子表格Excel实战技巧精粹，主要讲述以下几个功能：①Excel电子表格的基本功能；②Excel电子表格的数据分析；③电子表格中使用函数 基础；④使用函数技巧；⑤电子表格中函数高级应用；⑥图表与图形；⑦VBA二次开发...
中级excel实战训练-1
05-30
本“中级Excel实战训练-1”旨在深入讲解一系列实用技能，包括维度逆转、分列神技、定位专家、高级筛选以及有效性下拉框与二级有效性等。以下是对这些知识点的详细说明： 1. **维度逆转**： 维度逆转通常是指在处理...
Excel实战 第1章 数据处理
weixin_46713695的博客
01-13 1132
数据处理
Excel实战
weixin_44549096的博客
01-08 503
Excel实战 1、表格设计，自动求和、求平均值函数 打印预览按钮 添加边框 1、选中区域 2、选择对应的模式 3、预览效果 添加背景（不会被打印出来，只供自己看着舒服） 1、选中任意一个单元格，选择 页面布局-背景 2、效果 3、选中清单，背景填充 白色 4、选中 第一列，插入两列 5、将靠近清单一列，填充白色，缩小列宽 6、清单右侧，同样操作 7、清单上侧，添加一行，设置背景颜色：无填充 8、取消表格中的边框 9、效果展示 求和函数和求平均
实战excel
feverfew1的博客
01-31 481
文本为Excel中的常见格式，自由地使用Excel进行数据分析、数据统计，解放Excel不再为Excel所困
Excel自学三部曲_Part3：Excel工作场景实战（一）
最新发布
毛媛媛
09-01 701
Excel的高频场景和功能到底有哪些？
[Excel图表实战技巧精粹].Excel.Home.扫描版 百度云
libinhai110的博客
04-01 2050
链接：https://pan.baidu.com/s/1ZxDLfwgniEcj_zmMo5ioyA 提取码：ccei 无解压密码 放心自取 只求一赞
excel实战精粹
04-09
excel实战精粹是excelhome精心编织的excel学习资料
Excel实战技巧1000例.rar
04-19
"Excel实战技巧1000例"这个压缩包资源，无疑为Excel的学习者提供了一个丰富的实践宝库。以下将围绕Excel的一些重要知识点进行详细阐述，帮助你深入理解并运用这些技巧。 1. **公式与函数**：Excel的核心功能之一...
Excel实战技巧精粹：Excel模板1000例
07-02
《Excel实战技巧精粹：Excel模板1000例》是一部深入探讨Excel应用的宝典，旨在提升用户在日常工作中处理数据、分析信息和优化工作效率的能力。这本书包含了丰富的实例和实用模板，覆盖了从基础操作到高级技巧的全...
网页版EXCEL
12-14
网页版EXCEL，目前只兼容IE
Excel操作大全
11-28
Delphi动态调用Excel操作大全
Excel 按钮，多选框提交实例
moscot_wu的博客
05-13 878
用户有一个Excel，多个sheet，然后首页是一些下拉框和填充框，所有的数据在其他sheet页，客户非常苦恼每次需要在各页找到相关的内容，然或填写到首页，并且首页填写的内容可以自动填充到各个Sheet页。 方法：使用Excel的VB脚本实现，首页信息填充后，点击按钮实现提交的功能。脚本如下: Private Sub CheckBox1_Click() Dim n As Integer Di...
【一】Excel VBA开发 初探
oJuHao12345的专栏
05-26 3381
一、启用Excel VBA开发功能 1、点击Excel左上角的【文件】，然后点击文件下方的【选项】 2、【Excel选项】中点击【自定义功能区】，右边勾选【开发工具】，点击【确定】 3、返回excel sheet 页面。点击【开发工具】,我们将看到三个我们开发过程中必用的按钮，分别是：【Visual Basic】、【宏】、【录制宏】 二、启动VBA编辑 点击【Visual Basic】 三、代码学习 Office Visual Basic for Applic...
VBA 操作 VBE
weixin_33713503的博客
09-06 951
Introduction You can write code in VBA that reads or modifies other VBA projects, modules, or procedures. This is called extensibility because extends the editor -- you can used VBA code to create ne...
excel删除无尽空白行_将EXCEL工作表中无用处的空白行删除
weixin_39846364的博客
11-18 364
大家好，时间如白驹过隙，我很早以前开始学习利用VBA，忽然间已有20多年了。开发过大小不同的VBA程序程序已数不胜数。VBA是利用Office实现个人小型办公自动化的有效手段（工具），这是我的对VBA的定义。如今，在我的学习平台，以传递我多年实际经验为宗旨，授人以渔，传递给大家真正的VBA知识。如果大家对VBA感兴趣，认为VBA可以给自己的实际工作带来切实的帮助，最好系统学习我的教程，成为我的学员...
Excel技巧汇总
niejing654092427的专栏
07-11 1485
1、文本算式 =EVALUATE 2、设置单元格样式 选中所在的区域，右键，设置单元格格式，自定义，类型输入： 0.00%，确定。 3、插入行/列的快捷键 选中需要插入的位置，按下快捷键【Ctrl】+【+】（小键盘处的加号）即可 4、快速求和 对一列数据进行求和我们习惯了用sum函数，输入公式毕竟也需要时间，本着时间就是金钱的理念，我们要学会用快捷键进行求和，【Alt...
WorksheetFunction 成员 (Excel)
kx3216的专栏
11-13 5699
WorksheetFunction 成员 (Excel) 用作可从 Visual Basic 中调用的 Microsoft Excel 工作表函数的容器。  方法 名称 说明 AccrInt 返回定期付息有价证券的应计利息。 Ac
Excel高效实战： 提高桌面生产力（系列06-10）
Kevin勇闯天涯的BLOG
10-27 1486
Excel系列06：漫谈Excel中的数据类型1 在Excel的世界中，总归会遇到这样的问题：合计数据时总会有一些数据未计算在内，导致结果偏小；辛辛苦苦学会了Vlookup函数，查询匹配时却显示不出结果。其实，导致这种情况的原因都是文本型数值在作怪，看起来是“数值”的数据竟是“文本”。今天就和大家漫谈下Excel中的数据类型。掌握了数据类型，Excel中的很多问题也就迎刃而解了。 一、关于数据、
评论 1
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值