Results of 1 - 1 of about 37680 for IF (0.007 sec.)
- [[20200922011420]]
- #score: 1591
- @digest: f7a6b8b4fde4279eadfe97f77e4fda0a
- @id: 85249
- @mdate: 2020-09-23T08:13:08Z
- @size: 15467
- @type: text/plain
- #keywords: 限. (87217), 用期 (68083), 限設 (46807), newlimit (44989), 期限 (34660), （gs (23531), 元管 (22865), 一元 (16222), myd (13965), vbcancel (8771), 延長 (7821), vbokcancel (7714), 利用 (5324), 限を (5056), スワ (4487), 中断 (4261), 稲葉 (4181), 日以 (3870), password (3639), 2020 (3633), 定( (3612), ・ω (3316), thisworkbook (3199), ・` (3194), vbyesno (3059), 日時 (3050), msgbox (2720), inputbox (2705), 管理 (2677), date (2295), （稲 (2285), 葉） (2186)
- 『利用期限制限について』（GS）
質問よろしくお願いします。 現在、同一book内に以下マクロにて利用制限を行っていますが bookが名前を付けて保存した場合、複数のbookになり期日の延長 設定などが手間が掛かり困っています。そこで質問なのですが 以下のマクロの読込を外部（例えば、Cドライブにおいて）の ファイル等に書込（年月日時間）その設定をbookに読み込ませ openイベントを実行できないものかと考えてみたのですが、 識者の方の回答をお願いします。 Excelでは無理がありますか? 当然ですが、外部ファイルはパスワード等で管理します。 Sub Auto_Open() Dim MyD As Date MyD = #4/30/2021 12:00:00 AM# If Now() >= MyD Then MsgBox "利用期限が過ぎました" & Chr(10) & "ブックは使用できません", 48 ThisWorkbook.Close False End If End Sub ＜ 使用 Excel:Excel2019、使用 OS:Windows10 ＞ ---- アプリケーションで管理するPCレベルの情報管理手段としてレジストリが用意されていますので、 そこで情報を管理してはどうでしょうか。 http://officetanaka.net/excel/vba/tips/tips43.htm （QS） 2020/09/22(火) 01:40 ---- （QS）さん ありがとうございます。 閲覧させていただきましたが、レジストリですか 当方には、レベルが高いようです。book配布先などもあり もう少し単純な方法は、無いでしょうか? よろしくお願いします。 （GS） 2020/09/22(火) 02:14 ---- 現在日時はどこから取得するのでしょうか? ネット、単にPCの日時? この手の物は、結構抜け道があるかと・・・。 （Why） 2020/09/22(火) 02:52 ---- >bookが名前を付けて保存した場合 考え方を変えて、名前をつけて保存をマクロで実行してあげればよいのでは? んで、MyD = #4/30/2021 12:00:00 AM# この部分の日付をコンフィグシートとか適当に作って、いれておいて シートのvisibleプロパティをVeryhiddenに指定して、手動では表示できないようにするとか。 http://officetanaka.net/excel/vba/sheet/sheet06.htm （稲葉） 2020/09/22(火) 03:19 ---- （Why）さん ありがとうございます。 ＞現在日時はどこから取得するのでしょうか? ＞ネット、単にPCの日時? 単純に、PCの日時となります。 期限前は、利用可能 期限が来たら Auto_Openイベントで強制終了です。 （稲葉）さん ありがとうございます。 ＞ >bookが名前を付けて保存した場合 ＞ 考え方を変えて、名前をつけて保存をマクロで実行してあげればよいのでは? bookに名前を付ける以前の、オリジナルbookも同様にAuto_Openイベントの設定の 日付をすぎればオープンできないようにし、必要に応じこの日付を変更しオープン できるように外部ファイルを書換→修正し。1年延期 2年延期等・・・とか 更新したいのです。 わかりにくい説明ですがよろしくお願いします。 （GS） 2020/09/22(火) 04:23 ---- オリジナルにも隠しシートいれて、日付いれればいいのではないですか? ようはセキュリティではなく、ポカミス避けでしょ? マクロ無効で開けば、誰でも変更できちゃうコードだし、その程度で十分だと思うんだけど、、、 （稲葉） 2020/09/22(火) 05:36 ---- 日付を書き込んだエクセルファイル(利用期限.xls)も一緒に配る 期限を更新するときは、利用期限.xlsだけ配る 利用期限.xlsは読み取りパスワードをつけておく エクセルファイルなので、今とセキュリティレベルは変わりません。 Private Sub Workbook_Open() Dim myD As Date With Workbooks.Open(ThisWorkbook.Path & "¥利用期限.xlsx", ReadOnly:=True, Password:="password") myD = .Worksheets(1).Cells(1, 1).Value .Close SaveChanges:=False End With If Date >= Date Then MsgBox "利用期限は" & myD & "です" & vbLf & _ "利用期限が過ぎました" & vbLf & "ブックは使用できません", vbExclamation ThisWorkbook.Close False Else MsgBox "利用期限は" & myD & "です" End If End Sub 自分でWebサーバー立てられるなら、Web上で期限を読みに行くという方法もあるけど、 配布先のネット環境とかにもよるので、難しいかも （´・ω・`） 2020/09/22(火) 07:48 ---- あ、利用期限.xlsx は、同じフォルダに置くことを想定してますが、 見つからないときのエラー処理が必要ですね （´・ω・`） 2020/09/22(火) 07:50 ---- Private Sub Workbook_Open() Dim myD As Date If Dir(ThisWorkbook.Path & "¥利用期限.xlsx") <> "利用期限.xlsx" Then MsgBox "利用期限.xlsxが見つかりません" ThisWorkbook.Close False End If With Workbooks.Open(ThisWorkbook.Path & "¥利用期限.xlsx", ReadOnly:=True, Password:="password") myD = .Worksheets(1).Cells(1, 1).Value .Close SaveChanges:=False End With If Date >= myD Then MsgBox "利用期限は" & myD & "です" & vbLf & _ "利用期限が過ぎました" & vbLf & "ブックは使用できません", vbExclamation ThisWorkbook.Close False Else MsgBox "利用期限は" & myD & "です" End If End Sub （´・ω・`） 2020/09/22(火) 08:25 ---- （´・ω・`） さんの書き込みで理解できた気がする 一度手元から離れてしまったファイルの利用期限を延長する が主題だったのですね。 そしたら、私のやり方は不出来かもしれないけど・・・ 別ファイルを作った場合、 A,B,Cのどのファイルの利用期限なのかを識別する必要があるかもしれない 仮に1つでも、Aが更新前のものか、更新後のものかわからない 利用期限ファイルを1カ所のフォルダ（あるいはファイル）にした場合、アクセスできないユーザーがいるかもしれない という理由で、私は同じブックに入れておくことを勧めたいです。 基本2個のプログラム 1）新規ブックを作成する・・・・・・配布する段階になったら、こちらを実行し、ファイルを作成、そちらを配布する 2）現在のブックに期限を設定する・・一番最初に実行したとき、又はオリジナルを改定する必要が出てきたときに実行する オリジナルの期限が切れた場合、Shift押しながらファイルを開けば、Openイベントが発生しないので、 2）のプログラムを実行して、期限の延長ができる Thisworkbookモジュール Private Sub Workbook_Open() Dim myD As Date Dim ws As Worksheet On Error Resume Next Set ws = Sheets("limit") On Error GoTo 0 If ws Is Nothing Then Call 期限設定(False) Set ws = Sheets("limit") End If Do If IsDate(ws.Range("A1").Value) Then myD = ws.Range("A1").Value Exit Do Else If MsgBox("期限が設定されていません。期限を設定してください", vbOKCancel) = vbCancel Then MsgBox "処理を中断して、ブックを閉じます" ThisWorkbook.Close savechanges:=False End If End If Loop Select Case Date Case Is <= myD MsgBox Format$(myD, "利用期限はyyyy年m月d日までです。") Case Is > myD MsgBox "利用期限を過ぎています。管理者に更新を依頼してください" ThisWorkbook.Close savechanges:=False End Select End Sub 標準モジュール Sub 新規ブックを作成する() Call 期限設定(True) End Sub Sub 現在のブックに期限を設定する() Call 期限設定(False) End Sub Sub 期限設定(ByVal isNewBook As Boolean) Dim NewLimit As Date Dim buf As String Dim ws As Worksheet Const pw As String = "期限設定パスワード" '適宜変更してください On Error Resume Next Set ws = Sheets("limit") On Error GoTo 0 If ws Is Nothing Then Sheets.Add after:=Sheets(Sheets.Count) Set ws = Sheets(Sheets.Count) ws.Name = "limit" End If Do If InputBox("期限設定用パスワードを入力してください") = pw Then Exit Do Else If MsgBox("パスワードが違います。", vbOKCancel) = vbCancel Then Exit Sub End If End If Loop Do buf = Application.InputBox("新しい期限を設定してください 例:2020年11月5日=>2020/11/05", , Format$(Date, "yyyy/mm/dd"), , , , , 2) If IsDate(buf) Then If CDate(buf) <= Date Then If MsgBox("今日以前の日付ですが、よろしいですか?", vbYesNo) = vbYes Then Exit Do End If End If Else If MsgBox("日付を入力してください", vbOKCancel) = vbCancel Then MsgBox "処理を中断します" Exit Sub End If End If Loop NewLimit = CDate(buf) With ws .Range("A1").Value = NewLimit .Visible = xlVeryHidden End With ThisWorkbook.Save If isNewBook = True Then With ThisWorkbook '同じフォルダに日付&ファイルネームで保存 .SaveCopyAs .Path & "¥" & Format$(Date, "yyyymmdd") & .Name MsgBox "新しいブックが作成されました" Shell "C:¥Windows¥Explorer.exe " & .Path & "¥", vbNormalFocus End With End If End Sub （稲葉） 2020/09/22(火) 09:20 ---- 仕事で返事が遅くなり申し訳ありません。 （´・ω・`）さん ありがとうございます。 利用期限.xlsxを別のフォルダに置く場合は以下はどのように変更すれば 可能でしょうか? フルパスで別フォルダで一元管理を希望 If Dir(ThisWorkbook.Path & "¥利用期限.xlsx") <> "利用期限.xlsx" Then よろしくお願いします。 （稲葉）さん マクロを組み込んで、現在のブックに期限を設定する()を実行したのですが 日付が入力しても 例;2020/12/15 OKを押しても再度入力してください（このときのInputBoxの表示は2020/9/23←本日）と 何度も繰り返し出てしまうのですが、2020/9/23のみOKが可能のようです? limitシートは、作成済み A1に 日付入力済みなのですが・・・ テストの仕方が違うのでしょうか? 申し訳ないですが、もう少し指導お願いします。 （GS） 2020/09/23(水) 03:51 ---- （´・ω・`）さん 以下でできました 問題あれば指摘お願いします。 If Dir("C:¥works¥key.xlsx") <> "key.xlsx" Then （GS） 2020/09/23(水) 04:03 ---- （稲葉）さん buf = Application.InputBox("新しい期限を設定してください 例:2020年11月5日=>2020/11/05", , Format$(Date, "yyyy/mm/dd"), , , , , 2) If IsDate(buf) Then If CDate(buf) >= Date Then ★ If MsgBox("よろしいですか?", vbYesNo) = vbYes Then Exit Do End If End If 今日以上? 本日以上の入力なら上記で書込できたようです。 本日以下の場合の処理は、どのように記入すれば良いですか? => ←私の見当違いでしょうか? （GS） 2020/09/23(水) 04:29 ---- コードにミスありました 下記のところ直してください If CDate(buf) <= Date Then If MsgBox("今日以前の日付ですが、よろしいですか?", vbYesNo) = vbYes Then Exit Do End If else exit do End If あと一元管理については問題提起したので、ちょっとみてみてください （稲葉） 2020/09/23(水) 06:22 ---- （稲葉）さん ありがとうございます。 あとで修正します。 ＞あと一元管理については問題提起したので、ちょっとみてみてください ことらの↑は、問題ありですか? （GS） 2020/09/23(水) 12:50 ---- （稲葉）さん 2020/09/22(火) 09:20 このときのコメントですね 確かにありそうです。 （GS） 2020/09/23(水) 13:21 ---- せっかく書き直したので、投稿させてください・・・ 問題1 1つのブックだけを相手にするならそれでいいですが、 AブックとBブックをそれぞれ管理したい場合どうしますか? 利用期限ファイルを複数設けますか? その場合、AブックとBブックのマクロを書き換えますか? もしくはファイル名、シートの値またはプロパティ等で参照先を変更できるように組みますか? 問題2 仮に1つのブックだけ管理したい場合、バージョン管理はどうしますか? （´・ω・`） さんのコードだと、どのバージョンからでも利用期限が延長されることになります。 ファイル名またはシートにバージョンを特定できるように文言を入れてもいいかもしれませんが、 ユーザーに書き換えられた場合、利用期限が延長できるようになってしまいます。 実際に運用するときは、隠しシートかファイルのプロパティに仕込むことになると思います。 問題3 ローカルに置くなら関係ないかも知れませんが・・・ 実際はネットワークフォルダですよね? すべてのユーザーがアクセスできるフォルダに保管してありますか? また容易に削除できないような設計ですか? この3つを解決できれば、一元管理でもいいと思います。 もちろん私が知らないだけで、一元管理のほうが良い理由がたくさんあるかもしれませんので、 絶対とは言い切れません。 少なくとも私は、ブックの中で完結したほうが良いと思います。 （稲葉） 2020/09/23(水) 13:22 ---- （稲葉）さん 貴重なご意見ありがとうございます。 教えていただいたとおり使い分けが必要ですね 以下のように修正したのですが★部分で 【キャンセル】を選択した場合 エラー型が一致しません 以下処理違いますか? buf = Application.InputBox("新しい期限を設定してください 例:2020年11月5日=>2020/11/05", , Format$(Date, "yyyy/mm/dd"), , , , , 2) If CDate(buf) <= Date Then ★ If MsgBox("今日以前の日付ですが、よろしいですか?", vbYesNo) = vbYes Then Exit Do End If Else If MsgBox("日付を入力してください", vbOKCancel) = vbCancel Then MsgBox "処理を中断します" Exit Sub End If End If （GS） 2020/09/23(水) 16:34 ---- isDate処理が抜けてるためですね。 キャンセル押したときの処理追加したので、全部掲示しますね Sub 期限設定(ByVal isNewBook As Boolean) Dim NewLimit As Date Dim buf As String Dim ws As Worksheet Const pw As String = "期限設定パスワード" On Error Resume Next Set ws = Sheets("limit") On Error GoTo 0 If ws Is Nothing Then Sheets.Add after:=Sheets(Sheets.Count) Set ws = Sheets(Sheets.Count) ws.Name = "limit" End If Do If InputBox("期限設定用パスワードを入力してください") = pw Then Exit Do Else If MsgBox("パスワードが違います。", vbOKCancel) = vbCancel Then Exit Sub End If End If Loop Do buf = Application.InputBox("新しい期限を設定してください 例:2020年11月5日=>2020/11/05", , Format$(Date, "yyyy/mm/dd"), , , , , 2) If buf = "False" Then MsgBox "処理を中断します" Exit Sub End If If IsDate(buf) Then If CDate(buf) <= Date Then If MsgBox("今日以前の日付ですが、よろしいですか?", vbYesNo) = vbYes Then Exit Do End If Else Exit Do End If Else If MsgBox("日付を入力してください", vbOKCancel) = vbCancel Then MsgBox "処理を中断します" Exit Sub End If End If Loop NewLimit = CDate(buf) With ws .Range("A1").Value = NewLimit .Visible = xlVeryHidden End With ThisWorkbook.Save If isNewBook = True Then With ThisWorkbook '同じフォルダに日付&ファイルネームで保存 .SaveCopyAs .Path & "¥" & Format$(Date, "yyyymmdd") & .Name MsgBox "新しいブックが作成されました" Shell "C:¥Windows¥Explorer.exe " & .Path & "¥", vbNormalFocus End With End If End Sub （稲葉） 2020/09/23(水) 16:55 ---- （稲葉）さん ありがとうございました。 すっきりしました。 活用させていただきます。 今後共、よろしくお願いします。 （GS） 2020/09/23(水) 17:13... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/202009/20200922011420.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97037 documents and 608190 words.
訪問者：