| ' このページの分は ' かつ君さんの作成したマクロを利用させてもらいました。 ' 労働保険料管理のファイルからいただきました。 ' ありがとうございます｡ ' Sub setting() Dim S As String S = Sheets("設定表").TextBoxes("テキストpath").Text S = InputBox("システムの組込みﾊﾟｽ名は？", "ﾊﾟｽ名", S) If S = "" Then Exit Sub End If ActiveSheet.Protect DrawingObjects:=False, Contents:=False, Scenarios _ :=False Sheets("設定表").TextBoxes("テキストpath").Text = S ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios _ :=True End Sub |
シート「設定表」の中で、パス名を 記入するものです。 設定表にあるテキストボックスのマクロです。 S を 文字列変数として宣言します。 S に 先に入力してある文字列をとりこみます。 S を 表示して入力を待ちます。 S が 空白ならば作業終了です。（何もしないです）。 何かが入力されていれば次の作業をします。 テキストボックスの保護を解除します。 テキストボックス に S を 入れます。 テキストボックスに保護をかけます。 作業終了 | ||
| ' ' スタンプ会の発行還元の店別集計ファイルを呼び出します。 ' ' Sub 一覧集計作業へ() Dim DirName As String On Error GoTo ReadErr ans = MsgBox("集計ファイルを呼び出しますが、この経理ファイルを 一旦保存しましょうか？", vbYesNoCancel) If ans = vbYes Then ActiveWorkbook.Save DirName = Sheets("設定表").TextBoxes("テキストPath").Text If Mid$(DirName, 2, 1) = ":" Then ChDrive Left(DirName, 1) End If ChDir DirName Workbooks.Open Filename:=Sheets("設定表").Cells(49, 2).Value ActiveWorkbook.RunAutoMacros xlAutoOpen ElseIf ans = vbNo Then DirName = Sheets("設定表").TextBoxes("テキストPath").Text If Mid$(DirName, 2, 1) = ":" Then ChDrive Left(DirName, 1) End If ChDir DirName Workbooks.Open Filename:=Sheets("設定表").Cells(49, 2).Value ActiveWorkbook.RunAutoMacros xlAutoOpen End If Exit Sub ReadErr: MsgBox "ファイルが見つかりません! " + Sheets("設定表").Cells(49, 2).Value + "のインストール先のパスが正しいか確認して下さい " Exit Sub End Sub |
ここからが 上に入力したパス名を利用しての ファイルの呼び出し作業です。 DirName を 文字列変数として宣言します。 エラーが起きたら ReadErr に飛んで行きます。 ファイルの保存確認のメッセージ Yes の場合 現在のファイルを保存します。 （この場合は経理ファイルのことです） DirName に テキストボックス にあるパス名を セットします。先のマクロの S の部分です。 ドライブ名の確認です。 DirNameの２文字目が：（コロン）であり、１文字目 がドライブ名をあらわしています。 設定表の セルB49 に入力してあるファイルを 開きます。 そのファイルを開いたらそのファイルにある AutoOpenマクロ実行します。 No の場合 Yes の場合 と比べて違うのは ActiveWorkbook.Save がないこと。 あとはすべて同じです。 Yes でも No でも結局は ファイルを呼び出しに行くわけです。 集計ファイルの作業中にエラーが起こり 経理ファイルまで保存できずに終わったら 経理に入力したデータが消えてしまいます。 この防止の意味があるのです。 キャンセルの場合はここにきます。 ans の判定の IF の終了です。 エラーメッセージの表示です。 パス名やファイル名が違っていると表示されます。 ReadErrの作業終了 作業終了 | ||
Exit Sub
| |||
| ' '作業終了時の確認です。 'かつ君さんからいただきました。 '経理ファイルを終了するときに保存するかどうか確認します ' 変更があった場合最初に保存しないときには、 QUIT の段階で ' 今度はエクセルが保存するかかどうか聞いてきます。 ' Sub 登録() ans = MsgBox("保存しますか？", vbYesNo) If ans = vbYes Then ActiveWorkbook.Save End If ans = MsgBox("Ｅｘｃｅｌを終了しますか？", vbYesNo) If ans = vbYes Then Application.Quit End If End Sub |
Quit 開いているブックをまだ保存していない場合は、 変更を保存するかどうかを確認する ダイアログ ボックスが表示されます。 メッセージを表示させない場合は、 Quit メソッドを使う前にすべてのブックを 保存するか、 DisplayAlerts プロパティに False を設定します。 （釣り日誌などはこれを利用しています） DisplayAlerts プロパティに False が設定されて いると、確認メッセージは表示されず、 変更したブックを保存しないで、 Excel を終了します。 ブックを保存しなくても、 そのブックの Saved プロパティを True に 設定すると、確認メッセージを表示せずに Excel を終了させることができます。 |