麻辣家族討論版版 - Powered by Discuz! Board

'工作表上須有定義範圍名稱 [database]
'如無 ShowDataForm,以作用中儲存格的延伸範圍作為[database]
'如有 ShowDataForm 會以此[database] 作為表單的範圍
Option Explicit
Sub Ex_表單()
With ActiveSheet
.Names.Add "database", .Columns("B:H")
.ShowDataForm
End With
End Sub

複製代碼

'ThisWorkbook 模組的程式碼
Option Explicit
Private Sub Workbook_Open() '檔案開啟時自動執行的程式碼
工作表2.Ex_設定 '-> SHEETS("B")
End Sub

複製代碼

'工作表2 模組的程式碼 -> SHEETS("B")
Option Explicit
Private Sub Worksheet_Activate() '在SHEETS("B") 為作用中的工作表時,自動執行
Ex_設定
End Sub
Sub EX_首()
With SpinButton1
.Min = 2
.Value = .Min '給值會牽動上下筆的異動
End With
End Sub
Sub EX_末()
With SpinButton1
.Value = .Max '給值會牽動上下筆的異動
End With
End Sub
Private Sub SpinButton1_Change() '上下筆的異動
EX
End Sub
Private Sub EX()
Dim Rng As Range, Ar(), i As Integer
Set Rng = Range("C3,F3, B6, D6, B8, F7, D2") '制定員工資料卡上要輸入的儲存格
Ar = Sheets("A").Range("B" & SpinButton1).Resize(, 7).Value 'SpinButton1上的值導入陣列
Range("B2") = "'00" & SpinButton1 - 1
For i = 1 To Rng.Count
Rng.Areas(i) = Ar(1, i) 'Areas:因員工資料卡上要輸入的儲存格為不連續的範圍
'Areas 屬性傳回 Areas 集合，此集合代表多重範圍中的所有範圍。唯讀。
Next
Range("j2").Resize(UBound(Ar, 2)) = Application.Transpose(Ar)
End Sub
Sub Ex_設定() 'SpinButton 控制項
Dim Rng As Range, S As Variant
With Sheets("A")
Set Rng = .Range("b1", .Range("b2").End(xlDown)) '姓名欄的資料範圍
End With
S = Application.Match(Range("c3"), Rng, 0) '完全比對 Range("c3")的字串在姓名欄上的列號
With SpinButton1
.Max = Rng.Cells(Rng.Count).Row '最後的列號
.Min = 2
.Value = IIf(IsNumeric(S), S, 2) 'Range("c3")的字串,有比對到給列號,否給 2
End With
End Sub

複製代碼

Option Explicit
Dim Ar(), Sh As Worksheet, Msg As Boolean
Dim C_Button()
Private Sub UserForm_Initialize() '表單未顯示前的表單程式碼事件
Set Sh = Sheets("A") 'Database所在工作表
'****************************************************************
Ar = Array(myA, myB, myC, myD, myE, myF, myG, myH)
'顯示資料的控制項收集到陣列中
C_Button = Array(SpinButton1, CommandButton1, CommandButton2, B2)
'按鈕的控制項收集到陣列中
'*****************************************************************
myC.AddItem "男"
myC.AddItem "女"
Msg = True '資料讀取,寫入中
With SpinButton1
.Min = 2 '最小值=第2列號
.Max = Sh.Cells(Rows.Count, 1).End(xlUp).Row '最大值
If .Max = 1 Then '沒有資料
控制項 False '控制項不可使用
Else
資料讀取 .Value '有資料:讀取到控制項
End If
End With
Msg = False
End Sub
Private Sub B1_Click() '新增
Dim i As Integer
Msg = True '資料讀取,寫入中
控制項 True '控制項可使用
With SpinButton1
.Max = .Max + 1 '新增:增加一列,最大值 + 1
.Value = .Max '值要移到最大值
Ar(0).Caption = Format(.Max - 1, "0000") '編號
Sh.Cells(.Max, 1) = .Max - 1 '資料上的編號
Sh.Cells(.Max, 1).NumberFormatLocal = "0000" '編號的格式
End With
For i = 1 To 7
Ar(i).Value = "" '清除控制項的值
Next
Msg = False
End Sub
Private Sub B2_Click() '清除
Dim i As Integer
Msg = True
With SpinButton1
For i = 0 To 7 '清除控制項的值
If i = 0 Then
Ar(i).Caption = ""
Else
Ar(i).Value = ""
End If
Next
Sh.Cells(.Value, 1).Resize(, 8).Delete xlUp '刪除工作表上(.Value)列
.Max = .Max - 1 '清除:減少一列,最大值 - 1
If .Value > .Max Then .Value = .Max '當原本值> 最大值,值=最大值
If .Max = 1 Then '沒有資料
控制項 False '控制項不可使用
Else
'修改刪除後的編號
With Sh.Range(Sh.Range("A" & .Value), Sh.Range("A" & .Max))
.Cells = "=ROW()-1" '工作表上列號-1
.Value = .Value '公式轉成植
.NumberFormatLocal = "0000" '編號的格式
End With
Msg = False
資料讀取 SpinButton1
End If
End With
End Sub
Private Sub CommandButton1_Click() '最後一筆
With SpinButton1
.Value = .Max
End With
End Sub
Private Sub CommandButton2_Click() '第一筆
With SpinButton1
.Value = .Min
End With
End Sub
Private Sub myB_Change()
If Msg = False Then 資料寫入 SpinButton1
End Sub
Private Sub myC_Change()
If Msg = False Then 資料寫入 SpinButton1
End Sub
Private Sub myD_Change()
If Msg = False Then 資料寫入 SpinButton1
End Sub
Private Sub myE_Change()
If Msg = False Then 資料寫入 SpinButton1
End Sub
Private Sub myF_Change()
If Msg = False Then 資料寫入 SpinButton1
End Sub
Private Sub myG_Change()
If Msg = False Then 資料寫入 SpinButton1
End Sub
Private Sub myH_Change()
If Msg = False Then 資料寫入 SpinButton1
End Sub
Private Sub SpinButton1_Change() '按鍵有移動
If Msg = False Then 資料讀取 SpinButton1
End Sub
Private Sub SpinButton1_SpinDown() '按鍵向下移動
With SpinButton1
If .Value = .Min Then MsgBox "已是第一筆資料"
End With
End Sub
Private Sub SpinButton1_SpinUp() '按鍵向上移動
With SpinButton1
If .Value = .Max Then MsgBox "已是第最後一筆資料"
End With
End Sub
Private Sub 控制項(B As Boolean)
Dim E As Variant
For Each E In C_Button
E.Enabled = B
Next
End Sub
Private Sub 資料讀取(X As Long)
Dim i As Integer
Msg = True '資料讀取中
For i = 0 To 7
If i = 0 Then
Ar(i).Caption = Sh.Cells(X, 1).Text
Else
Ar(i).Value = Sh.Cells(X, i + 1)
End If
Next
Msg = False '資料不在讀取中
End Sub
Private Sub 資料寫入(X As Long)
Dim i As Integer
Msg = True '資料寫入中
For i = 0 To 7
If i = 0 Then
With Sh.Cells(X, 1)
.Value = SpinButton1 - 1
.NumberFormatLocal = "0000"
End With
Else
Sh.Cells(X, i + 1) = Ar(i).Value
End If
Next
Msg = False '資料不在寫入中
End Sub

複製代碼