| |
長いので2つに分けさせて頂きます。
本当に申し訳ございません。
frm Jyouken↓
'
'［キャンセル］ボタンがクリックされたときの処理
'
Private Sub cmdCancel_Click()
' 条件などを変更せずにユーザーフォームを隠す
frmJyouken.Hide
End Sub
'
'［決定］ボタンがクリックされた場合の処理
'
Private Sub cmdKettei_Click()
Dim Message As String
Dim Seibetsu As String
Dim MetaAddStr As String
' frmMainのラベルに表示する抽出条件のメッセージを作る
Message = "抽出条件："
' シート［抽出条件］の条件を記入するセルをクリア（空）にする
Worksheets("抽出条件").Range("A2:G2").Clear
' 図書番号を抽出条件にした場合
If chkTosyo.Value = True Then
' 検索文字として不適当な文字を変換する
MetaAddStr = MetaCharCheck(txtTosyo.Text)
' シート［抽出条件］のセルA2に、選択肢の番号に従って
' 抽出条件を書き込む
WriteJyoukenSheetString "A2", MetaAddStr, cmbTosyoJyouken.ListIndex
' frmMainに表示する抽出条件のメッセージを作成
Message = Message & vbCrLf & "図書番号に" & Chr(34) & txtTosyo & Chr(34) & "という" & cmbTosyoJyouken.Text
End If
' タイトルを抽出条件にした場合
If chkTitle.Value = True Then
' 検索文字として不適当な文字を変換する
MetaAddStr = MetaCharCheck(txtTitle.Text)
' シート［抽出条件］のセルB2に、選択肢の番号に従って
' 抽出条件を書き込む
WriteJyoukenSheetString "B2", MetaAddStr, cmbTitleJyouken.ListIndex
' frmMainに表示する抽出条件のメッセージを作成
Message = Message & vbCrLf & "タイトルに" & Chr(34) & txtTitle & Chr(34) & "という" & cmbTitleJyouken.Text
End If
' 著者を抽出条件にした場合
If chkTyosya.Value = True Then
' 検索文字として不適当な文字を変換する
MetaAddStr = MetaCharCheck(txtTyosya.Text)
' シート［抽出条件］のセルC2に、選択肢の番号に従って
' 抽出条件を書き込む
WriteJyoukenSheetString "C2", MetaAddStr, cmbTyosyaJyouken.ListIndex
' frmMainに表示する抽出条件のメッセージを作成
Message = Message & vbCrLf & "著者に" & Chr(34) & txtTyosya & Chr(34) & "という" & cmbTyosyaJyouken.Text
End If
' 出版社を抽出条件にした場合
If chkSyuppansya.Value = True Then
' 検索文字として不適当な文字を変換する
MetaAddStr = MetaCharCheck(txtSyuppansya.Text)
' シート［抽出条件］のセルD2に、選択肢の番号に従って
' 抽出条件を書き込む
WriteJyoukenSheetString "D2", MetaAddStr, cmbSyuppansyaJyouken.ListIndex
' frmMainに表示する抽出条件のメッセージを作成
Message = Message & vbCrLf & "出版社に" & Chr(34) & txtSyuppansya & Chr(34) & "という" & cmbSyuppansyaJyouken.Text
End If
' 分野を抽出条件にした場合
If chkBunya.Value = True Then
' 検索文字として不適当な文字を変換する
MetaAddStr = MetaCharCheck(txtBunya.Text)
' シート［抽出条件］のセルE2に、選択肢の番号に従って
' 抽出条件を書き込む
WriteJyoukenSheetString "E2", MetaAddStr, cmbBunyaJyouken.ListIndex
' frmMainに表示する抽出条件のメッセージを作成
Message = Message & vbCrLf & "分野に" & Chr(34) & txtBunya & Chr(34) & "という" & cmbBunyaJyouken.Text
End If
' 分類を抽出条件にした場合
If chkBunrui.Value = True Then
' 検索文字として不適当な文字を変換する
MetaAddStr = MetaCharCheck(txtBunrui.Text)
' シート［抽出条件］のセルF2に、選択肢の番号に従って
' 抽出条件を書き込む
WriteJyoukenSheetString "F2", MetaAddStr, cmbBunruiJyouken.ListIndex
' frmMainに表示する抽出条件のメッセージを作成
Message = Message & vbCrLf & "分類に" & Chr(34) & txtBunrui & Chr(34) & "という" & cmbBunruiJyouken.Text
End If
' 棚番を抽出条件にした場合
If chkTanaban.Value = True Then
' 検索文字として不適当な文字を変換する
MetaAddStr = MetaCharCheck(txtTanaban.Text)
' シート［抽出条件］のセルG2に、選択肢の番号に従って
' 抽出条件を書き込む
WriteJyoukenSheetString "G2", MetaAddStr, cmbTanabanJyouken.ListIndex
' frmMainに表示する抽出条件のメッセージを作成
Message = Message & vbCrLf & "棚番に" & Chr(34) & txtTanaban & Chr(34) & "という" & cmbTanabanJyouken.Text
End If
' メッセージができあがった時点で、frmMainのlblJyoukenに表示する
frmMain.lblJyouken.Caption = Message
' 抽出条件が変更された場合、抽出表示モードを解除
frmMain.tglCyuusyutsu.Value = False
' frmMainの［条件を満たすデータを抽出］ボタンにフォーカスを合わせる
frmMain.tglCyuusyutsu.SetFocus
' 抽出条件を設定するユーザーフォームを隠す
' 隠しているだけなので、次回表示されたときは前回の設定値が保持されている
frmJyouken.Hide
' シート［抽出条件］を表示する（確認用）
Worksheets("抽出条件").Select
End Sub
Private Sub Label4_Click()
End Sub
' ユーザーフォームの閉じるボタンがクリックされたときの処理
'
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
' 閉じるボタンの操作で発生したイベントかどうかを調べる
If CloseMode = vbFormControlMenu Then
MsgBox ("［決定］か［キャンセル］ボタンをクリックしてください。")
' 引数Cancelに0以外（ここではTrue）を指定しプロシージャを
' 終了すると、ユーザーフォームを閉じる処理を無効化できる
Cancel = True
End If
End Sub
'
' 引数で指定された条件に従い、文字列の抽出条件式をシート［抽出条件］に書き込む
'
' 引 数：CellName（String型） 書き込むセル（A1形式であること）
' StringValue（String型） 条件となる文字列
' IndexNo（Integer型) 文字列の条件（シート［抽出条件］のIndexNoを参照）
'
Sub WriteJyoukenSheetString(CellName As String, StringValue As String, IndexNo As Integer)
Dim SetStr As String
' 文字列系の条件の選択肢に応じて、抽出条件として指定する
' 文字列を作成する
Select Case IndexNo
Case 0 ' 文字列を含む
SetStr = "*" & StringValue & "*"
Case 1 ' 文字列から始まる
SetStr = StringValue & "*"
Case 2 ' 文字列と完全一致
SetStr = StringValue
Case Else
MsgBox "コンボボックスで選ばれたListIndexの値が不正です。"
Stop
End Select
' ワークシートに条件式を書き込む
Worksheets("抽出条件").Range(CellName).Value = SetStr
End Sub
' 検索用の文字として不適当なアスタリスク（*）と疑問符（?）が含まれる場合、
' メタキャラクタのチルダ（~）を付加するFunctionプロシージャ
'
' 引 数：SrcStr（String型） 検索用文字列
' 戻り値：MetaCharCheck（String型） メタキャラクタを付加した検索文字列
'
Function MetaCharCheck(SrcStr As String) As String
Dim i As Long
Dim Moji As String
Dim OutStr As String
' 空の文字列が指定された場合は何もせず空の文字列を返す
If SrcStr = "" Then
MetaCharCheck = ""
Exit Function
End If
' SrcStrの文字列中にアスタリスク（*）や疑問符（?）が含まれているか
For i = 1 To Len(SrcStr)
' SrcStrを左から1文字ずつ取り出す
Moji = Mid(SrcStr, i, 1)
' 取り出した文字がアスタリスク（*）または疑問符（?）ではないか
If InStr("*?", Moji) <> 0 Then
' アスタリスク（*）や疑問符（?）の場合はメタキャラクタの
' チルダ（~）を付加する
Moji = "~" & Moji
End If
' 取り出した文字を1文字ずつ連結していく
' メタキャラクタを付加した場合は2文字追加となる
OutStr = OutStr + Moji
Next i
' 連結した文字列を戻り値とする
MetaCharCheck = OutStr
End Function
↓標準モジュール
Sub シートからデータを抽出して表示()
frmMain.Show vbModeless
End Sub
|
|
ろんろん
- 10/5/11(火) 15:49 -
