以下のマクロがその部分です。

' このページの分は
' かつ君さんの作成したマクロを利用させてもらいました。
' 労働保険料管理のファイルからいただきました。
' ありがとうございます。
'
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の2文字目が:(コロン)であり、1文字目
がドライブ名をあらわしています。

設定表の セルB49 に入力してあるファイルを
開きます。
そのファイルを開いたらそのファイルにある
AutoOpenマクロ実行します。

No の場合
  Yes の場合 と比べて違うのは
  ActiveWorkbook.Save
  がないこと。
  あとはすべて同じです。 

 Yes でも No でも結局は
 ファイルを呼び出しに行くわけです。
 集計ファイルの作業中にエラーが起こり
 経理ファイルまで保存できずに終わったら
 経理に入力したデータが消えてしまいます。
 この防止の意味があるのです。

キャンセルの場合はここにきます。
ans の判定の IF の終了です。




エラーメッセージの表示です。

パス名やファイル名が違っていると表示されます。


ReadErrの作業終了

作業終了
Exit Sub
このステートメントのある Sub プロシージャを
直ちに抜けます。
制御は Sub プロシージャを呼び出した
ステートメントの次のステートメントに移ります。
ChDir path
現在のフォルダを変更します。

引数 path は必ず指定します。
引数 path には、新しく設定するフォルダを
表す文字列式を指定します。
引数 path には、
既定のドライブ名が含まれています。
ドライブ名を省略してフォルダを指定すると、
ChDir ステートメントは現在のフォルダを
現在のドライブの該当するフォルダに変更します。

解説

ChDir ステートメントを使用すると、
フォルダを変更できます。
ただし、ドライブは変更されません。
たとえば、現在のドライブが C のとき、
次に示すステートメントは、
D ドライブのフォルダを変更しますが、
現在のドライブは C のまま変更されません。

ChDir "D:\TMP"
'
'作業終了時の確認です。
'かつ君さんからいただきました。
'経理ファイルを終了するときに保存するかどうか確認します
'  変更があった場合最初に保存しないときには、 QUIT の段階で
'  今度はエクセルが保存するかかどうか聞いてきます。
'
Sub 登録()

ans = MsgBox("保存しますか?", vbYesNo)

If ans = vbYes Then
ActiveWorkbook.Save
End If

ans = MsgBox("Excelを終了しますか?", vbYesNo)

If ans = vbYes Then
Application.Quit
End If

End Sub
Quit

開いているブックをまだ保存していない場合は、
変更を保存するかどうかを確認する
ダイアログ ボックスが表示されます。

メッセージを表示させない場合は、
Quit メソッドを使う前にすべてのブックを
保存するか、
DisplayAlerts プロパティに False を設定します。
  (釣り日誌などはこれを利用しています)
DisplayAlerts プロパティに False が設定されて
いると、確認メッセージは表示されず、
変更したブックを保存しないで、
Excel を終了します。

ブックを保存しなくても、
そのブックの Saved プロパティを True に
設定すると、確認メッセージを表示せずに
Excel を終了させることができます。

TOPへ戻る                                前へ戻る

inserted by FC2 system