Excelで取引先表を作ってみよう
Step 12 「抽出」コードの作成 その4 ユーザーフォームの変更
これまで抽出結果をメインフォームに表示しようとしていたが、あまりに複雑になり分かり難いので、ユーザーフォームに表示するように変更する。
Homeに戻る >
Excelでアプリケーションソフト >
取引先表アプリ
標準モジュールコード
下のコードに変更してください。
Option Explicit
'データ変更の有無
Public bDataChangeFlag As Boolean
'抽出結果数を保持
Public RecordCount As Long
抽出フォームコード
下のコードを追加してください。
Private Sub ExEnabled(bsw As Boolean)
Dim lcol As Long
Frame1.Enabled = bsw
If bsw Then
lcol = -2147483643
Else
lcol = 14737632
End If
TextBox14.BackColor = lcol
TextBox15.BackColor = lcol
TextBox16.BackColor = lcol
TextBox17.BackColor = lcol
TextBox18.BackColor = lcol
TextBox19.BackColor = lcol
TextBox20.BackColor = lcol
TextBox21.BackColor = lcol
TextBox22.BackColor = lcol
TextBox23.BackColor = lcol
TextBox24.BackColor = lcol
TextBox25.BackColor = lcol
CommandButton3.Enabled = bsw
CommandButton4.Enabled = bsw
CommandButton5.Enabled = bsw
CommandButton6.Enabled = bsw
CommandButton7.Enabled = bsw
End Sub
下のコードに変更してください。
Private Function ExFillterInputCheck() As Boolean
Dim bflag As Boolean
Dim last As Long
FillterCount = 0
'条件のクリア
Range("Z5:AL5") = ""
last = Sheets("抽出").Range("A65536").End(xlUp).Row
If last > 4 Then
Sheets("抽出").Range("A5:L" & last) = ""
End If
bflag = False
'ID MIN
If TextBox1 <> "" Then
If IsNumeric(TextBox1) Then
bflag = True
Range("Z5") = ">=" & TextBox1
End If
End If
'ID MAX
If TextBox2 <> "" Then
If IsNumeric(TextBox2) Then
bflag = True
Range("AA5") = "<=" & TextBox2
End If
End If
'会社名
If TextBox3 <> "" Then
bflag = True
Range("AB5") = "*" & TextBox3 & "*"
End If
'担当者名
If TextBox4 <> "" Then
bflag = True
Range("AC5") = "*" & TextBox4 & "*"
End If
'〒
If TextBox5 <> "" Then
bflag = True
Range("AD5") = "*" & TextBox5 & "*"
End If
'住所
If TextBox6 <> "" Then
bflag = True
Range("AE5") = "*" & TextBox6 & "*"
End If
'電話番号
If TextBox7 <> "" Then
bflag = True
Range("AF5") = "*" & TextBox7 & "*"
End If
'携帯
If TextBox8 <> "" Then
bflag = True
Range("AG5") = "*" & TextBox8 & "*"
End If
'FAX番号
If TextBox9 <> "" Then
bflag = True
Range("AH5") = "*" & TextBox9 & "*"
End If
'メール
If TextBox10 <> "" Then
bflag = True
Range("AI5") = "*" & TextBox10 & "*"
End If
'支払い
If TextBox11 <> "" Then
bflag = True
Range("AJ5") = "*" & TextBox11 & "*"
End If
'口座番号
If TextBox12 <> "" Then
bflag = True
Range("AK5") = "*" & TextBox12 & "*"
End If
'備考
If TextBox13 <> "" Then
bflag = True
Range("AL5") = "*" & TextBox13 & "*"
End If
If bflag Then
last = Sheets("T取引先").Range("A65536").End(xlUp).Row
Sheets("T取引先").Range("A4:L" & last).AdvancedFilter Action:=xlFilterCopy, _
Criteriarange:=Range("Z4:AL5"), copytorange:=Sheets("抽出").Range("A4:L4"), unique:=False
last = Sheets("抽出").Range("A65536").End(xlUp).Row
If last = 4 Then
ExEnabled False
Label14.Caption = "見つかりませんでした。"
Else
ExEnabled True
Label14.Caption = last - 4 & " 件見つかりました。"
FillterCount = last - 4
End If
Label14.Visible = True
End If
End Function
Private Sub UserForm_Initialize()
ExEnabled False
End Sub
メインシートコード
下のコードを削除してください。
'抽出トグルボタン
Private Sub ToggleButton1_Click()
ToggleButton2.Value = Not ToggleButton1.Value
CommandButton1.Enabled = Not ToggleButton1.Value
If ToggleButton1.Value Then
Frm抽出.Show
If FillterCount = 0 Then
ToggleButton1.Value = False
ToggleButton2.Value = Not ToggleButton1.Value
CommandButton1.Enabled = Not ToggleButton1.Value
Else
Sheets("メイン").Range("E3") = "( /" & FillterCount & " )"
Sheets("メイン").Range("E3").Font.Color = vbRed
End If
End If
End Sub
'解除トグルボタン
Private Sub ToggleButton2_Click()
ToggleButton1.Value = Not ToggleButton2.Value
CommandButton1.Enabled = ToggleButton2.Value
If ToggleButton2.Value = True Then
Sheets("メイン").Range("E3") = "( /" & RecordCount & " )"
Sheets("メイン").Range("E3").Font.Color = vbBlack
End If
End Sub
下のコードを追加してください。
Private Sub CommandButton7_Click()
Frm抽出.Show
End Sub
メインフォーム
抽出結果表示部分を追加します。
Homeに戻る >
Excelでアプリケーションソフト >
取引先表アプリ
■■■
このサイトの内容を利用して発生した、いかなる問題にも一切責任は負いませんのでご了承下さい
■■■
当ホームページに掲載されているあらゆる内容の無許可転載・転用を禁止します
Copyright (c) Excel-Excel ! All rights reserved