ExcelVBAでプログラムを実行させたときに2つのファイルを参照します。 (1)結果コピー先ファイル (2)データ元ファイル この2つのファイルのうち、いずれかがなかった場合にメッセージを表示させたいのですが思うように表示されません。 以下のように動作させたいのですがうまくいきません。 (1)2種類のファイルがないときには両方のメッセージを 1つの画面に表示したい。 (2)どちらか一方のファイルがないときには、 エラーメッセージを表示させエラーのないファイルを 表示させない。 ※いろいろ試したら(a)がないメッセージが表示されたが、 (b)のファイルが表示された。 (3)正常に処理が終了した場合は、完了メッセージを表示したい。 途中まで書いてみたコードは以下の通りです。 ※実行コードは中略します。 '////////////////////////////////////////////////////// Sub test1() Dim sMsg As String Dim sMyDir As String sMyDir = ThisWorkbook.Path & "\" Dim Ws As Worksheet Dim vTgYear As Variant Dim Wb As Workbook Set Wb = Workbooks("算出プログラム.xls") Set Ws = Wb.Sheets("入力内容") vTgYear = Ws.Range("D17").Value With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Dim sWbkName As String, StName As String Dim wbk結果1 As Variant sWbkName = "3_結果\結果.xls" StName = "Sheet1" Dim sWbkSubName As String sWbkSubName = "1_算定表\" & vTgYear & "_算定表.xls" Dim Kname As String, Mname As String Kname = sMyDir & sWbkName Mname = sMyDir & sWbkSubName Dim buf As String On Error GoTo myError Open sMyDir & "3_結果\結果.xls" For Input As #1 Line Input #1, buf Close #1 On Error GoTo ErrorHandler2 If Dir(Mname) <> "" Then Workbooks.Open Filename:=Mname, Password:="aaaaa" Else Dim Wb1 As Workbook Set Wb1 = Workbooks("結果.xls") Set wbk結果 = Wb1.Sheets(StName) Dim wbkA As Variant Dim sShtName As String sShtName = "地域1" Dim Wb2 As Workbook Set Wb2 = Workbooks(vTgYear & "_算定表.xls") Set wbk地域A = Wb2.Sheets(sShtName) wbk結果.Range("F9:N9").Value = wbk地域A.Range("AB7:AK7").Value wbk結果.Range("F10:N10").Value = wbk地域A.Range("AB51:AK51").Value wbk結果.Range("F11:N11").Value = wbk地域A.Range("AB95:AK95").Value wbk結果.Range("F12:N12").Value = wbk地域A.Range("AB139:AK139").Value wbk結果.Range("F13:N13").Value = wbk地域A.Range("AB183:AK183").Value wbk結果.Range("F14:N14").Value = wbk地域A.Range("AB227:AK227").Value wbk結果.Range("F15:N15").Value = wbk地域A.Range("AB271:AK271").Value wbk結果.Range("F16:N16").Value = wbk地域A.Range("AB315:AK315").Value ≪後略≫ Application.DisplayAlerts = False wbk結果1.SaveAs Filename:=sMyDir & "3_結果\" & vTgYear & "_テスト.xls" ' Application.DisplayAlerts = True With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With Workbooks(vTgYear & "_算定表.xls").Close SaveChanges:=False MsgBox "計算期間" & "「" & kenko_Label_10 & "」で" & vbLf & "ファイルを作成しました。", vbInformation Close #1 Exit Sub myError: MsgBox "出力先の「結果_健康寿命」ファイルが存在しません。" & _ vbLf & "処理を終了します。", vbOKOnly + vbExclamation Exit Sub ErrorHandler2: MsgBox "指定年の「長野県健康寿命算定表」" & _ vbLf & "ファイルが存在しません。処理を終了します。", vbOKOnly + vbExclamation End If End Sub '////////////////////////////////////////////////////// メッセージ画面以外は正常に動作することを確認しています。 メッセージ画面について教えてください。 素人で申し訳ありませんが、よろしくお願い致します。
↧