4月 06, 2021
'ThisWorkbook
Private Sub Workbook_Open()
shtApp.Activate
UserForm1.Show
End Sub
Private Sub Workbook_Open()
shtApp.Activate
UserForm1.Show
End Sub
'ShtApp
Private Sub Worksheet_activate()
UserForm1.Show
End Sub
Private Sub Worksheet_Deactivate()
UserForm1.Hide
End Sub
' UserForm
Dim gnDataRow As Long
Private Sub Userform_Initialize()
gnDataRow = -1
End Sub
Private Sub SearchData(ByVal nSearchCol As Integer, ByVal strCondition As String)
Dim row As Long
listData.Clear
For row = 2 To shtData.UsedRange.Rows.Count
If InStr(shtData.Cells(row, nSearchCol).Value, strCondition) > 0 Then
listData.AddItem Str(row) & vbTab & shtData.Cells(row, 1).Value & vbTab & shtData.Cells(row, 2).Value & vbTab & shtData.Cells(row, 3).Value & vbTab & shtData.Cells(row, 4).Value
End If
Next row
End Sub
Private Sub btnName_Click()
SearchData 1, txtName.Text
End Sub
Private Sub btnMobile_Click()
SearchData 2, txtMobile.Text
End Sub
Private Sub btnPhone_Click()
SearchData 3, txtPhone.Text
End Sub
Private Sub btnAddr_Click()
SearchData 4, txtAddr.Text
End Sub
Private Sub btnAdd_Click()
Dim name As String, mobile As String, phone As String, addr As String
Dim row As Long
name = txtName.Text
If "" = name Then
MsgBox "請先輸入姓名", vbOKOnly, "資料新增"
Exit Sub ' 離開副程式
End If
mobile = txtMobile.Text
phone = txtPhone.Text
addr = txtAddr.Text
For row = 2 To shtData.UsedRange.Rows.Count ' 檢查是否有名字重複
If shtData.Cells(row, 1).Value = name Then
Exit For
End If
Next row
If row <= shtData.UsedRange.Rows.Count Then
If vbNo = MsgBox("名稱重複，是否確定加入?", vbYesNo, "名稱重複") Then
Exit Sub ' 離開副程式
Else
row = shtData.UsedRange.Rows.Count
End If
End If
shtData.Cells(row, 1).Value = name
shtData.Cells(row, 1).HorizontalAlignment = xlCenter
shtData.Cells(row, 2).Value = mobile
shtData.Cells(row, 2).HorizontalAlignment = xlCenter
shtData.Cells(row, 3).Value = phone
shtData.Cells(row, 3).HorizontalAlignment = xlCenter
shtData.Cells(row, 4).Value = addr
SearchData 1, ""
gnDataRow = -1
End Sub
Private Sub btnModify_Click()
If -1 = gnDataRow Then
MsgBox "請先從列表中選擇資料", vbOKOnly, "資料修改"
Exit Sub
End If
shtData.Cells(gnDataRow, 1).Value = txtName.Text
shtData.Cells(gnDataRow, 1).HorizontalAlignment = xlCenter
shtData.Cells(gnDataRow, 2).Value = txtMobile.Text
shtData.Cells(gnDataRow, 2).HorizontalAlignment = xlCenter
shtData.Cells(gnDataRow, 3).Value = txtPhone.Text
shtData.Cells(gnDataRow, 3).HorizontalAlignment = xlCenter
shtData.Cells(gnDataRow, 4).Value = txtAddr.Text
SearchData 1, txtName.Text
gnDataRow = -1
End Sub
Private Sub btnDelete_Click()
If -1 = gnDataRow Then
MsgBox "請先從列表中選擇資料", vbOKOnly, "資料刪除"
Exit Sub
End If
shtData.Rows(gnDataRow).EntireRow.Delete
SearchData 1, ""
gnDataRow = -1
End Sub
Private Sub listData_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If listData.Text = "" Then
Exit Sub
End If
Dim arrStr() As String
arrStr = Split(listData.Text, vbTab)
gnDataRow = Int(arrStr(0))
txtName.Text = arrStr(1)
txtMobile.Text = arrStr(2)
txtPhone.Text = arrStr(3)
txtAddr.Text = arrStr(4)
End Sub
Posted in: 
