演習15 のユーザーフォーム コード
------ [UserForm1] -------
Private Sub Address_Click()
MsgBox "演習13 を参考にシート上で作業せよ"
Workbooks("addres07.xls").Activate
End
End Sub
Private Sub Address2_Click()
Workbooks("addres07.xls").Activate
End
End Sub
Private Sub Filter_Click()
Workbooks("addres07.xls").Activate
Range("A1").CurrentRegion.Select
Range("A1").Select
Selection.AutoFilter
End Sub
Private Sub Sort1_Click()
Workbooks("addres07.xls").Activate
Range("A1").CurrentRegion.Select
Selection.Sort _
Key1:=Range("A2"), _
Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin
End Sub
Private Sub Sort2_Click()
Workbooks("addres07.xls").Activate
Range("A1").CurrentRegion.Select
Selection.Sort _
Key1:=Range("B2"), _
Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin
End Sub
Private Sub Sample_Click()
Workbooks("sample07.xls").Activate
End
End Sub
Private Sub SpinButton1_Change()
'Max = 1000, Min = 1
TextBox1.Text = SpinButton1.Value
With Workbooks("addres07.xls"). _
Worksheets("Sheet1")
TextBox2.Text = .Range("B" & TextBox1.Text + 1).Value
TextBox3.Text = .Range("C" & TextBox1.Text + 1).Value
TextBox4.Text = .Range("D" & TextBox1.Text + 1).Value
TextBox5.Text = .Range("E" & TextBox1.Text + 1).Value
TextBox6.Text = .Range("F" & TextBox1.Text + 1).Value
End With
End Sub
Private Sub UserForm_Initialize()
With Workbooks("addres07.xls"). _
Worksheets("Sheet1")
TextBox1.Text = .Range("A2").Value
TextBox2.Text = .Range("B2").Value
TextBox3.Text = .Range("C2").Value
TextBox4.Text = .Range("D2").Value
TextBox5.Text = .Range("E2").Value
TextBox6.Text = .Range("F2").Value
End With
End Sub
------ [Module1] -------
Sub Show_UserForm()
Workbooks("addres07.xls").Activate
UserForm1.Show
End Sub
------ [ThisWorkbook] -------
Private Sub Workbook_Open()
PathName = ThisWorkbook.FullName
If InStrRev(PathName, "\") > 0 Then
PathName = Left(PathName, InStrRev(PathName, "\") - 1)
End If
Workbooks.Open (PathName + "\addres07.xls")
ThisWorkbook.Activate
End Sub
back top