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

Private Sub TextBox1_Change()
ActiveCell = TextBox1
End Sub

複製代碼

Private Sub Worksheet_SelectionChange(ByVal T As Range)
Select Case T.Row
Case 3
If UserForm2.Visible Then Unload UserForm2
With UserForm1
.Label2 = Cells(2, T.Column)
.TextBox1 = T.Value
.Show (0)
End With
Case 4
If UserForm1.Visible Then Unload UserForm1
UserForm2.TextBox1 = T.Value
UserForm2.Show (0)
Case Else
End Select
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Row
Case 3
If UserForm2.Visible Then Unload UserForm2
With UserForm1
' .Label2 = Cells(2, T.Column)
.TextBox1 = Target.Value
'.Show (0)
End With
Case 4
If UserForm1.Visible Then Unload UserForm1
UserForm2.TextBox1 = Target.Value
'UserForm2.Show (0)
Case 15 '申請類別
If Target < 1 Or Target > 4 Then
MsgBox "申請類別須為 1 - 4 之間 "
Else
Check_Box 申請類別, Target.Value
End If
Case 16 '核准種類
If Target < 1 Or Target > 5 Then
MsgBox "核准種類須為 1 - 5 之間 "
Else
Check_Box "核准種類", Target.Value
End If
Case 22 '源.方式...請自行練習
End Select
End Sub
Private Sub Check_Box(ByVal xTitle As String, ByVal No As Integer) '9999(A)表單中項目勾選的子程式
Dim Ar(), E As Object
With Sheet1 'SHEETS("999A")
Select Case xTitle
Case "申請類別" '指定的項目置入陣列
Ar = Array(.Shapes("Check Box 830"), .Shapes("Check Box 829"), .Shapes("Check Box 827"), .Shapes("Check Box 828"))
Case "核准種類" '指定的項目置入陣列
Ar = Array(.Shapes("Check Box 10"), .Shapes("Check Box 12"), .Shapes("Check Box 14"), .Shapes("Check Box 39"), .Shapes("Check Box 13"))
Case Else
MsgBox "申請 ?? 程式碼有誤 "
Exit Sub
End Select
End With
For Each E In Ar '所有指定的項目
E.OLEFormat.Object.Value = 0 '取消
Next
Ar(No - 1).OLEFormat.Object.Value = 1 '勾選
End Sub

複製代碼

Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Row
Case 3
If UserForm2.Visible Then Unload UserForm2
With UserForm1
' .Label2 = Cells(2, T.Column)
.TextBox1 = Target.Value
'.Show (0)
End With
Case 4
If UserForm1.Visible Then Unload UserForm1
UserForm2.TextBox1 = Target.Value
'UserForm2.Show (0)
Case 15 '申請類別
If Target < 1 Or Target > 4 Then
MsgBox "申請類別須為 1 - 4 之間 "
Else
Check_Box "AO24:AR24", Target.Value
End If
Case 16 '核准種類
If Target < 1 Or Target > 5 Then
MsgBox "核准種類須為 1 - 5 之間 "
Else
Check_Box "AO25:AS25", Target.Value
End If
Case 22 '源.方式...請自行練習
End Select
End Sub
Private Sub Check_Box(ByVal xRange As String, ByVal No As Integer) '9999(A)表單中項目勾選的子程式
With Sheet1.Range(xRange) '所有指定項目的連結楚存格
.Cells = "" '清除=>False
.Cells(1, No) = 1 '勾選=>True
End With
End Sub

複製代碼

Private Sub Worksheet_SelectionChange(ByVal T As Range)
If T.Count > 1 Then
MsgBox T.Address & " 範圍必須是單一的儲存格"
Exit Sub
End If
'如不要上述的程式碼 T ->T.Cells(1) 或 T(1)
Select Case T.Row 'T.Cells(1).Row
Case 3
If UserForm2.Visible Then Unload UserForm2
With UserForm1
.Label2 = Cells(2, T.Column)
.TextBox1 = T.Value '->T.Cells(1) 或T(1)
.Show (0)
End With
Case 4
If UserForm1.Visible Then Unload UserForm1
UserForm2.TextBox1 = T.Value '->T.Cells(1) 或T(1)
UserForm2.Show (0)
Case 37
If UserForm2.Visible Then Unload UserForm2
UserForm26.TextBox1 = T.Value '->T.Cells(1) 或T(1)
UserForm26.Show (0)
Case Else
End Select
End Sub

複製代碼

Dim Rng As Range, xAr()
Private Sub UserForm_Initialize()
Dim i As Integer
With ComboBox1
.AddItem "20　房地建地（不含建物）"
.AddItem "21　空地"
.AddItem "22　農地"
.AddItem "23　林地"
.AddItem "24　養殖地"
.AddItem "25　土地及建物（住宅用）"
.AddItem "26　土地及廠房"
.AddItem "27　不含土地之建物（住宅用）"
.AddItem "28　不含土地之廠房"
.AddItem "29　高爾夫球場"
.AddItem "2X　其他不動產"
.AddItem "2A　土地及建物（商業用）"
.AddItem "2B　不含土地之建物（商業用）"
End With
' xAr = Array("20　房地建地（不含建物）", "21　空地","22　農地",,,,,)
' xAr = Sheets("資料").Range("A1:A15").Value
' ComboBox1.List = xAr
Set Rng = Cells(37, ActiveCell.Column).Resize(13) '
Debug.Print Rng.Address
ReDim xAr(1 To Rng.Count)
For i = 1 To Rng.Count
Set xAr(i) = Controls("TextBox" & i)
Controls("TextBox" & i) = Rng(i).Text '工作表資料寫到 TextBox
Next
'TextBox8 = [B37] '調整從1開始對應到工作表上的儲存格
'TextBox9 = [B38] '.....
'*****或是指定TextBox位置對應到工作表上的儲存格
'i = 0
'For Each E In Array(5, 6, 9, 12, 1, 4, 2, 3)
' Set xAr(i) = Controls("TextBox" & E)
' Controls("TextBox" & E) = Rng(i + 1)
'Next
'***************************************
'
End Sub
Private Sub CommandButton1_Click() '確定資料寫到工作表上
For i = 1 To Rng.Count
Rng(i) = xAr(i).Text
Next
End Sub
Private Sub ComboBox1_Change()
TextBox9 = Left(ComboBox1, 2)
End Sub
Private Sub OptionButton1_Click()
If OptionButton1 = True Then
TextBox7 = Cells(3, Rng.Column).Value
Else
TextBox7 = ""
End If
End Sub

複製代碼