| |
▼kanabun さん：
大変申し訳ありません。
Option Explicit
Public TS_Sht As Worksheet ': Set Ts_Sht = Worksheets("テスト用")
Public AD_Sht As Worksheet ' 管理設定シート
Public EL_Sht As Worksheet ' イベント一覧シート（Event-List）[List:表]
Public EC_Sht As Worksheet ' イベント対応シート（Event-Cope）[Cope:対処]
Public WK_Sht As Worksheet ' ワーク用シート
Public fs As Variant
Public fi As Variant
Public Open_SW As String ' オープンエラー確認[ｴﾗｰ有:Error ｴﾗｰ無:OK]
Public Open_SW1 As String ' 現在の設定イベント一覧確認[有:OK 無:NG]
Public Open_SW2 As String ' 現在の設定イベント対応確認[有:OK 無:NG]
Public TL_Name As String ' 起動ツール名（ファイル名）
Public TL_Path As String ' 起動ツールのフルパス名
Public WK_Name As String ' ワーク用イベント一覧名（ファイル名）
Public WK_Path As String ' ワーク用イベント一覧のフルパス名
Public WK_Path2 As String ' 参照のフルパス名
Public WK_Date1 As String ' ワーク用更新日１
Public WK_Date2 As String ' ワーク用更新日２
Public AD_Name1 As String ' 現在の設定イベント一覧内容（ファイル名）
Public AD_Name2 As String ' 現在の設定イベント対応内容（ファイル名）
Public AD_Path1 As String ' 現在の設定イベント一覧内容のフルパス名
Public AD_Path2 As String ' 現在の設定イベント対応内容のフルパス名
Public AD_Proc1 As String ' イベント一覧の更新処理（ON:処理あり OFF:処理なし）
Public AD_Proc2 As String ' イベント対応の更新処理（ON:処理あり OFF:処理なし）
Public Name1 As String ' イベント一覧名（ファイル名）
Public Name2 As String ' イベント対応（ファイル名）
Public Path1 As String ' イベント一覧のフルパス名
Public Path2 As String ' イベント対応のフルパス名
Public Folder_Name As String ' 当ツールの上位フォルダ名
Public AD_Date1 As String ' 管理設定シート上のイベント一覧表の更新日
Public AD_Date2 As String ' 管理設定シート上のイベント対応表の更新日
Public Cnt(60) ' カウンタの配列（イベント表検索にて使用）
Public WK_Box1 As String ' 検索画面 クラス 選択コンボボックス用
Public WK_Box2 As String ' 検索画面 メッセージ選択コンボボックス用
Public WK_Box3 As String ' 対応画面 クラス 選択コンボボックス用
Public WK_Box4 As String ' 対応画面 対応クラス選択コンボボックス用
Public Search_Code1 As String ' 検索画面にて選択した障害の対応コード引渡し用（対応表示用）
Public Search_Code2 As String ' 検索画面にて選択した障害の対応コード引渡し用（対応種類用）
Public List_End, Cope_End ' ワークエリア
Public EL_Cnt, EC_Cnt
Public EL_Disp_S, EL_Disp_E, EC_Disp_S, EC_Disp_E
Public i, j, k ' 添字エリア
Sub Auto_Open()
Application.DisplayAlerts = False ' Display 非表示
' Application.DisplayAlerts = True ' Display 表示
Application.Visible = False
' Application.ScreenUpdating = False
' 初期値設定処理
Variable_Set
' ファイルチェック（当ツールで使用するExcelの、イベント一覧.xls・イベント対応.xls がオープンされている時は、クローズする）
i = Workbooks.Count
Do Until i = 1
If (Workbooks(i).Name = "TEC103イベント一覧.xls") Or _
(Workbooks(i).Name = "TEC104イベント対応.xls") Then
Workbooks(i).Close SaveChanges:=False
End If
i = i - 1
Loop
' 現在の設定ファイルの有無確認
Open_SW1 = "NG"
Open_SW2 = "NG"
' イベント一覧.xls・イベント対応.xls の存在チェック
' 存在する場合は、Open_SWにOKがセットされる
File_Open_CHK
' ファイル 検索
' └フォルダ 検索
i = 1
j = 1
Do Until InStr(i, TL_Path, "\") = 0 'TL_Path = 当ツールのフルパス名 （￥全てを検索し終わるまで繰り返す）
Cnt(j) = InStr(i, TL_Path, "\") 'Excelブック名の前に付いている￥の位置をセットする
i = Cnt(j) + 1 'i = 当ツール名の先頭の位置
j = j + 1 'j = ￥検索の為に繰り返した回数 = カウンタ配列のセットされたカウンタの位置
Loop
Cnt(0) = j - 1
' イベント一覧.xlsの存在チェックで、NGの場合、再度検索を行う。
' └イベント一覧 検索
If Open_SW1 = "NG" Then
WK_Name = "TEC103イベント一覧.xls"
WK_Path = ""
File_Search 'イベント一覧.xlsの検索
If Open_SW = "Error" Then
Exit Sub
End If
AD_Name1 = WK_Name
AD_Path1 = WK_Path '検索出来たイベント一覧.xlsの絶対パスをセット
End If
' イベント対応.xlsの存在チェックで、NGの場合、再度検索を行う。
' └イベント対応 検索
If Open_SW2 = "NG" Then
WK_Name = "TEC104イベント対応.xls"
WK_Path = ""
File_Search 'イベント対応.xlsの検索
If Open_SW = "Error" Then
Exit Sub
End If
AD_Name2 = WK_Name
AD_Path2 = WK_Path '検索出来たイベント対応.xlsの絶対パスをセット
End If
Set fs = CreateObject("Scripting.FileSystemObject") ' 日付取得
' イベント一覧・対応の更新日チェック
For i = 1 To 2
Select Case i
Case 1: Set fi = fs.getfile(AD_Path1) ' イベント一覧セット
WK_Date1 = AD_Date1
Select Case i
Case 1: AD_Proc1 = "ON" ' イベント一覧更新処理あり
AD_Sht.Cells(2, 3) = WK_Date2 ' 管理情報シートの最新データに、イベント一覧の最終更新日をセット
Case 2: AD_Proc2 = "ON" ' イベント対応更新処理あり
AD_Sht.Cells(3, 3) = WK_Date2 ' 管理情報シートの最新データに、イベント対応の最終更新日をセット
End Select
End If
Next
' Application.WindowState = xlMinimized ' テストの為に最小化
' 当ツールの保持する２つのExcelの最終更新日よりも、実際の更新日が新しい場合のみ、更新用のフォームを開く
If (AD_Proc1 = "ON") Or (AD_Proc2 = "ON") Then
Uf_Main.Show
Else
Uf_Search.Show
' MsgBox "Search"
End If
End Sub
' * Ｆｕｎｃｔｉｏｎ領域 スタート
'
Function Variable_Set() ' シート名・パス名等のセット
' シート設定
Set AD_Sht = Worksheets("管理設定")
Set EL_Sht = Worksheets("イベント一覧")
Set EC_Sht = Worksheets("イベント対応")
' ツール情報設定
TL_Name = ActiveWorkbook.Name 'Excelの名前のセット
TL_Path = ActiveWorkbook.FullName 'Excelのフルパス＆名前のセット
' 管理設定シート情報セット
AD_Path1 = AD_Sht.Cells(6, 2) 'TEC103イベント一覧.xlsのパス
AD_Path2 = AD_Sht.Cells(7, 2) 'TEC104イベント対応.xlsのパス
AD_Name1 = AD_Sht.Cells(6, 5) 'TEC103イベント一覧
AD_Name2 = AD_Sht.Cells(7, 5) 'TEC104イベント対応
AD_Date1 = AD_Sht.Cells(2, 2)
AD_Date2 = AD_Sht.Cells(3, 2)
AD_Proc1 = "OFF"
AD_Proc2 = "OFF"
End Function
Function File_Open_CHK() ' 関連Excelの、イベント一覧・イベント対応のオープン・クローズによって、存在をチェックする
On Error GoTo Open_Error ' オープンエラーの場合、Open_Errorに飛ぶ
Dim SW
'存在チェックのため、イベント一覧.xlsを開いて閉じる
'AD_Path1 : イベント一覧.xlsのフルパス名（管理設定シート内）
Open_Event1:
SW = 1
Workbooks.Open Filename:=AD_Path1 'TEC103イベント一覧.xlsのオープン
ActiveWorkbook.Close
Open_SW1 = "OK"
'存在チェックのため、イベント対応.xlsを開いて閉じる
'AD_Path2 : イベント対応.xlsのフルパス名（管理設定シート内）
Open_Event2:
SW = 2
Workbooks.Open Filename:=AD_Path2 'TEC104イベント対応.xlsのオープン
ActiveWorkbook.Close
Open_SW2 = "OK"
Exit Function
Open_Error:
If Err.Number <> 1004 Then 'ファイルが存在しないとき以外のエラーの場合
MsgBox Err.Description
Exit Function
End If
If SW = 1 Then '２つ目のファイルのオープンが行われていない場合
Resume Open_Event2 'Open_Event2に飛ぶ
End If
End Function
Function File_Search() ' ファイル検索
Open_SW = "OK"
Set fs = Application.FileSearch
j = Cnt(0)
Do Until j = 0
With fs
.LookIn = Left(TL_Path, Cnt(j)) '検索するフォルダのセット
.SearchSubFolders = True 'フォルダ配下のフォルダ内も検索する
.Filename = WK_Name '検索するファイル名のセット
If (.Execute < 1) And (j = 1) Then '検索出来たファイル数が０以下のときは、エラー
MsgBox "【 " & WK_Name & " 】 対象ファイルなし " & Chr(10) & Chr(10) & _
"対象ファイルを準備後、処理して下さい。"
Open_SW = "Error"
Exit Function
End If
If .Execute > 0 Then '検索出来たファイル数が１以上のとき
For i = 1 To .Execute '検索出来たファイル中に、同名ファイルが存在した場合、フォルダのパスをセット
If "\" & .Filename = Right(.FoundFiles(i), 17) Then
WK_Path = .FoundFiles(i)
Exit Do
End If
Next
End If
End With
j = j - 1
Loop
End Function
|
|
佐藤小次郎
- 14/8/13(水) 0:37 -
