有効期限が切れるとファイルが役に立たなくなり、ファイルの新しいバージョンを取得するために私に連絡する必要があるように、有効期限を設定する必要がある Excel ワークシートがあります。
マクロが有効になっておらず、続行するにはマクロを有効にする必要があるとシートが読み取った場合、最初のワークシートを強制的に表示し、シート 2 (日付を含む) を非表示にするスクリプトを作成しました。マクロを有効にすると、シート 2 が表示され、データを利用できるようになります。マクロが有効になると、スクリプトは有効期限コマンドを実行し、現在の日付が有効期限を過ぎると、ファイルが期限切れであることをユーザーに警告するメッセージ ウィンドウが表示されます。問題は、このメッセージ ウィンドウを閉じた後、Excel がユーザーに保存、保存しない、またはキャンセルするように求めることです。ユーザーがキャンセルを選択した場合、表示される次のメッセージ ボックスは有効期限ウィンドウで、有効期限が残りの日数を報告しています。その後、そのウィンドウを閉じて、電卓にアクセスできます。
以下の「ActiveWorkbook.Save = True」機能に手を出しましたが、何もありません。
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ActiveWorkbook.Saved = True
End Sub
ユーザーがマクロを有効にする必要があるワークシートを無効にしますが、それは基本的にファイルを役に立たなくします。
VBA スクリプトを添付しました。皆様のお役に立てれば幸いです。
本当にありがとう!
コードは次のとおりです。
Private Const dsWarningSheet As String = "sheet1" 'Enter name of the Entry/Warning Page
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
For Each ds In ActiveWorkbook.Sheets
If LCase(dsWarningSheet) = LCase(ds.Name) Then
ds.Visible = True
End If
Next
サブ終了
プライベート サブ Workbook_Open()
Dim myCount 'This line of code is optional
Dim i 'This line of code is optional
Dim Edate As Date
On Error Resume Next
myCount = Application.Sheets.Count
For i = 2 To myCount
Sheets(i).Visible = True
If i = myCount Then
Sheets(1).Visible = xlVeryHidden
End If
Next i
Edate = Format("13/01/2012", "DD/MM/YYYY") ' Replace this with the date you want
If Date > Edate Then
MsgBox ("This worksheet was valid upto " & Format(Edate, "dd-mmm-yyyy") & " and will be closed: Please contact John Smith at Company ABC to purchase a new version of this calculator")
ActiveWorkbook.Close
End If
If Edate - Date < 30 Then
MsgBox ("This worksheet expires on " & Format(Edate, "dd-mmm-yyyy") & " You have " & Edate - Date & " Days left")
End If
サブ終了
Private Sub Workbook_BeforeClose(ブール値としてキャンセル)
Dim myCount 'This line of code is optional
Dim i 'This line of code is optional
On Error Resume Next
myCount = Application.Sheets.Count
Sheets(1).Visible = True
Range("A1").Select
For i = 2 To myCount
Sheets(i).Visible = xlVeryHidden
If i = myCount Then
End If
Next i
ActiveWorkbook.Save
サブ終了
プライベート サブ Workbook_Openxx()
Dim myCount 'This line of code is optional
Dim i 'This line of code is optional
On Error Resume Next
myCount = Application.Sheets.Count
For i = 2 To myCount
Sheets(i).Visible = True
If i = myCount Then
Sheets(1).Visible = xlVeryHidden
End If
Next i
サブ終了