Today, we created an address book using VBA (Excel ).

Yesterday, one of my classmates lost their mobile phones, and all their phone numbers were lost. Therefore, I felt it necessary to back up the mobile phone numbers. So today I made an address book in Excel ----- VBA for one day. I will publish these codes tonight. Code writing is ugly. Due to time constraints. The Code has no comments. Please forgive me! The software has image descriptions!

========================================================== ========================================================== ====

Sub auto_open ()
Worksheets ("Address Book record"). Activate
Worksheets ("Address Book panel"). Activate
End sub
========================================================== ========================================================== ===

Private sub worksheet_activate ()
Combobox2.clear
Combobox2.additem "university student"
Combobox2.additem "High School Students"
Combobox2.additem "colleague"
Combobox2.additem "friend"
End sub

Private sub worksheet_deactivate ()
Combobox2.clear
Combobox2.additem "university student"
Combobox2.additem "High School Students"
Combobox2.additem "colleague"
Combobox2.additem "friend"
End sub

Private sub commandbutton#click ()
Call to add address book
End sub
Sub add Address Book ()
Dim Xingming, Shouji, gudingdianhua, QQ, email, guanxi, shengri, laojia as string
Dim K as integer
Xingming = trim (textbox1.text)
If Xingming = "" then
Msgbox "name cannot be empty record. Please enter Name Data! ", Vbokonly," Reminder"
Exit sub
End if
Shouji = textbox5.text
Gudingdianhua = textbox4.text
Qq = textbox6.text
Email = textbox2.text
Shengri = textbox7.text
Laojia = textbox3.text
Guanxi = combobox2.text
K = TJ ("Address Book record ")
With worksheets ("Address Book record ")
. Cells (k, 1). value = Xingming
. Cells (K, 2). value = Shouji
. Cells (K, 3). value = gudingdianhua
. Cells (K, 4). value = QQ
. Cells (K, 5). value = Email
. Cells (K, 6). value = shengri
. Cells (K, 7). value = laojia
. Cells (K, 8). value = Guanxi
End
Call clear data
End sub
Function TJ (LB) as integer
Dim K as integer
Dim flag as Boolean
K = 2
Flag = false
With worksheets (LB)
Do
If trim (. cells (k, 1). Value) <> "" then
K = k + 1
Else: Flag = true
End if
Loop until flag
End
TJ = K
End Function
Private sub commandbutton2_click ()
Call clear data
End sub
Private sub commandbutton4_click ()
Dim K, I as integer
Dim lab1, lab2 as string
Commandbutton7.enabled = true
Lab1 = trim (mid (TRIM (label11.caption), 4, Len (TRIM (label11.caption)-3 ))
Lab2 = trim (mid (TRIM (label9.caption), 5, Len (TRIM (label9.caption)-7 ))
If lab1 = lab2 then
Commandbutton4.enabled = false
Exit sub
Else: commandbutton4.enabled = true
End if
K = Val (lab1) + 1
I = k + 1
Label11.caption = "ID:" & K
With worksheets ("query result ")
Textbox1.text =. cells (I, 1). Value
Textbox5.text =. cells (I, 2). Value
Textbox4.text =. cells (I, 3). Value
Textbox6.text =. cells (I, 4). Value
Textbox2.text =. cells (I, 5). Value
Textbox7.text =. cells (I, 6). Value
Textbox3.text =. cells (I, 7). Value
Combobox2.text =. cells (I, 8). Value
End
Lab1 = trim (mid (TRIM (label11.caption), 4, Len (TRIM (label11.caption)-3 ))
If lab1 = lab2 then
Commandbutton4.enabled = false
Exit sub
Else: commandbutton4.enabled = true
End if
End sub

Private sub commandbutton5_click ()
Dim K, I as integer
Dim lab as string
Dim Xingming, Shouji, gudingdianhua, QQ, email, guanxi, shengri, laojia as string
Xingming = trim (textbox1.text)
If Xingming = "" then
Msgbox "name cannot be empty record. Please enter Name Data! ", Vbokonly," Reminder"
Exit sub
End if
Shouji = textbox5.text
Gudingdianhua = textbox4.text
Qq = textbox6.text
Email = textbox2.text
Shengri = textbox7.text
Laojia = textbox3.text
Guanxi = combobox2.text
Lab = trim (mid (TRIM (label11.caption), 4, Len (TRIM (label11.caption)-3 ))
I = Val (LAB) + 1
K = Val (worksheets ("query result"). cells (I, 9). value)
With worksheets ("query result ")
. Cells (I, 1). value = Xingming
. Cells (I, 2). value = Shouji
. Cells (I, 3). value = gudingdianhua
. Cells (I, 4). value = QQ
. Cells (I, 5). value = Email
. Cells (I, 6). value = shengri
. Cells (I, 7). value = laojia
. Cells (I, 8). value = Guanxi
End
With worksheets ("Address Book record ")
. Cells (k, 1). value = Xingming
. Cells (K, 2). value = Shouji
. Cells (K, 3). value = gudingdianhua
. Cells (K, 4). value = QQ
. Cells (K, 5). value = Email
. Cells (K, 6). value = shengri
. Cells (K, 7). value = laojia
. Cells (K, 8). value = Guanxi
End
Msgbox "modified successfully! "
End sub

Private sub commandbutton6_click ()
Call show add Address Book button
End sub

Private sub commandbutton7_click ()
Dim K, I as integer
Dim lab as string
Commandbutton4.enabled = true
Lab = trim (mid (TRIM (label11.caption), 4, Len (TRIM (label11.caption)-3 ))
If lab = 0 or lab = 1 then
Commandbutton7.enabled = false
Exit sub
Else: commandbutton7.enabled = true
End if
I = Val (LAB)
K = I-1
Label11.caption = "ID:" & K
With worksheets ("query result ")
Textbox1.text =. cells (I, 1). Value
Textbox5.text =. cells (I, 2). Value
Textbox4.text =. cells (I, 3). Value
Textbox6.text =. cells (I, 4). Value
Textbox2.text =. cells (I, 5). Value
Textbox7.text =. cells (I, 6). Value
Textbox3.text =. cells (I, 7). Value
Combobox2.text =. cells (I, 8). Value
End
Lab = trim (mid (TRIM (label11.caption), 4, Len (TRIM (label11.caption)-3 ))
If lab = 0 or lab = 1 then
Commandbutton7.enabled = false
Exit sub
Else: commandbutton7.enabled = true
End if
End sub

Sub clear data ()
Textbox1.text = ""
Textbox2.text = ""
Textbox3.text = ""
Textbox4.text = ""
Textbox5.text = ""
Textbox6.text = ""
Textbox7.text = ""
Combobox2.text = ""
End sub
Function query () as Boolean
Dim I, K as integer
Dim Xingming, Shouji, gudingdianhua, QQ, email, guanxi, shengri, laojia as string
K = 2
I = 2
Query = false
Xingming = trim (textbox8.text)
Do
Xingming2 = trim (worksheets ("Address Book record"). cells (I, 1). value)
If Xingming = xingming2 then
With worksheets ("Address Book record ")
Shouji =. cells (I, 2). Value
Gudingdianhua =. cells (I, 3). Value
Qq =. cells (I, 4). Value
Email =. cells (I, 5). Value
Shengri =. cells (I, 6). Value
Laojia =. cells (I, 7). Value
Guanxi =. cells (I, 8). Value
End
With worksheets ("query result ")
. Cells (k, 1). value = Xingming
. Cells (K, 2). value = Shouji
. Cells (K, 3). value = gudingdianhua
. Cells (K, 4). value = QQ
. Cells (K, 5). value = Email
. Cells (K, 6). value = shengri
. Cells (K, 7). value = laojia
. Cells (K, 8). value = Guanxi
. Cells (K, 9). value = I
. Cells (K, 10). value = k-1
K = k + 1
End
End if
I = I + 1
Xingming2 = trim (worksheets ("Address Book record"). cells (I, 1). value)
If xingming2 = "" then
If K> 2 then
Query = true
Label9.caption = "found" & K-2 & "record"
If commandbutton1.visible = true or commandbutton2.visible = true then
Call display query button
Else: Exit Function
End if
Exit Function
Else: MSG = msgbox ("no information for this person! "& CHR (13) & CHR (13) &" add this person's information? "& CHR (13) & CHR (13 )&_
"Confirm Jian: add information" & CHR (13) & "cancel key: Re-query", vbokcancel, "No such person information record! ")
If MSG = vbok then
Call clear data
Textbox8.text = ""
Textbox1.text = Xingming
If commandbutton1.visible = false or commandbutton2.visible = false then
Call show add Address Book button
Else: Exit Function
End if
Else
Textbox8.text = ""
Exit Function
End if
End if
Exit Function
End if
Loop until false
End Function
Private sub commandbutton3_click ()
Dim I, K as integer
Dim flag as Boolean
Dim lab as string
I = TJ ("query result ")
Call clear data
For k = 2 to I
With worksheets ("query result ")
. Cells (k, 1). value = ""
. Cells (K, 2). value = ""
. Cells (K, 3). value = ""
. Cells (K, 4). value = ""
. Cells (K, 5). value = ""
. Cells (K, 6). value = ""
. Cells (K, 7). value = ""
. Cells (K, 8). value = ""
. Cells (K, 9). value = ""
. Cells (K, 10). value = ""
End
Next
Flag = false
If trim (textbox8.text) = "" then
Msgbox "Enter the name you want to query", vbokonly, "error reminder"
Exit sub
End if
Flag = Query
If flag = true then
Label11.caption = "ID: 1"
With worksheets ("query result ")
Textbox1.text =. cells (2, 1). Value
Textbox5.text =. cells (2, 2). Value
Textbox4.text =. cells (2, 3). Value
Textbox6.text =. cells (2, 4). Value
Textbox2.text =. cells (2, 5). Value
Textbox7.text =. cells (2, 6). Value
Textbox3.text =. cells (2, 7). Value
Combobox2.text =. cells (2, 8). Value
End
End if
Textbox8.text = ""
Lab1 = trim (mid (TRIM (label11.caption), 4, Len (TRIM (label11.caption)-3 ))
If lab1 = 0 or lab1 = 1 then
Commandbutton7.enabled = false
Else: commandbutton7.enabled = true
End if
Lab2 = trim (mid (TRIM (label9.caption), 5, Len (TRIM (label9.caption)-7 ))
If lab1 = lab2 then
Commandbutton4.enabled = false
Else: commandbutton4.enabled = true
End if
End sub

Sub display add Address Book ()
Label9.caption = "added communication records"
Label11.visible = false
Commandbutton4.visible = false
Commandbutton4.enabled = false
Commandbutton5.visible = false
Commandbutton5.enabled = false
Commandbutton6.visible = false
Commandbutton6.enabled = false
Commandbutton7.visible = false
Commandbutton7.enabled = false
Commandbutton1.visible = true
Commandbutton1.enabled = true
Commandbutton2.visible = true
Commandbutton2.enabled = true
End sub
Sub display query ()
Label11.visible = true
Commandbutton4.visible = true
Commandbutton4.enabled = true
Commandbutton5.visible = true
Commandbutton5.enabled = true
Commandbutton6.visible = true
Commandbutton6.enabled = true
Commandbutton7.visible = true
Commandbutton7.enabled = true
Commandbutton1.visible = false
Commandbutton1.enabled = false
Commandbutton2.visible = false
Commandbutton2.enabled = false
End sub