0

有効期限が切れるとファイルが役に立たなくなり、ファイルの新しいバージョンを取得するために私に連絡する必要があるように、有効期限を設定する必要がある 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

サブ終了

4

2 に答える 2

0

これは私の最初の投稿です。この問題の解決策を作成しました。それをあなたと共有したいと思います。

Excel ワークブック、アドインなどの有効期限を設定する場合は、次のコードを使用して、ユーザーにメッセージを表示し、アドインを削除、閉じ、アンインストールします (該当する場合)。

ファイルの Workbook_Open イベントに追加し、プロジェクトの VBA コードにパスワードを設定するだけです。

有効期限が切れてユーザーがファイルを開くと、完全に消去されます。

Private Sub Workbook_Open()

Dim exdate As Date
Dim i As Integer

anul = 2015   ' (year) change these according to your expiration date
luna = 11     '(month)
ziua = 1      '(day)     

exdate = DateSerial(anul, luna, ziua)

If Date > exdate Then
    MsgBox ("The application " & ThisWorkbook.Name & " has expired !" & vbNewLine & vbNewLine _
    & "Expiration set up date is: " & exdate & " :)" & vbNewLine & vbNewLine _
    & "Contact xxx person(you) to renew the version !"), vbCritical, ThisWorkbook.Name

    expired_file = ThisWorkbook.Path & "\" & ThisWorkbook.Name


   On Error GoTo ErrorHandler
With Workbooks(ThisWorkbook.Name)
    If .Path <> "" Then

        .Saved = True
        .ChangeFileAccess xlReadOnly

        Kill expired_file

        'get the name of the addin if it is addin and unistall addin
        If Application.Version >= 12 Then
         i = 5
        Else: i = 4
        End If

        If Right(ThisWorkbook.Name, i) = ".xlam" Or Right(ThisWorkbook.Name, i) = ".xla" Then
            wbName = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - i)
             'uninstall addin if it is installed
             If AddIns(wbName).Installed = True Then
                AddIns(wbName).Installed = False
              End If
        End If

        .Close

    End If
End With

Exit Sub

End If

Exit Sub

ErrorHandler:
MsgBox "Fail to delete file.. "
Exit Sub

End Sub

さて、私の質問は、ユーザーがファイルを使用しているコンピューターや退職日を確認するコードをどのように書くかということです。

ユーザーが職場の PC 以外の PC でファイルを使用できないようにする何らかのコードが必要です。(退職時にExcelツールを持ち歩かないようにするため)。

于 2015-11-29T09:51:50.890 に答える