演習16 のユーザーフォーム コード


------ [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 CommandButton1_Click()
  If SpinButton1.Min > SpinButton1.Value - 5 Then
    Exit Sub
  Else
    SpinButton1.Value = SpinButton1.Value - 5
    'ここで SpinButton1 の Change が発生
  End If
End Sub

Private Sub CommandButton2_Click()
  If SpinButton1.Max < SpinButton1.Value + 5 Then
    Exit Sub
  Else
    SpinButton1.Value = SpinButton1.Value + 5
    'ここで SpinButton1 の Change が発生
  End If
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