[已解决]限制工作簿使用次数

秀才遇到兵

运行这段代码：

Sub CustomDocumentProperties()
  ThisWorkbook.CustomDocumentProperties.Add _
            Name:="OpenTimes", _
            LinkToContent:=False, _
            Type:=msoPropertyTypeNumber, _
            Value:=0
End Sub

删掉上面代码
然后在工作簿VB编辑器里 ThisWorkbook 里面粘贴这段代码
Private Sub Workbook_Open()
     Dim Opentimes As Integer
     With Me
         Opentimes = .CustomDocumentProperties("OpenTimes").Value + 1
         If Opentimes > 3 Then
             .Saved = True
             .ChangeFileAccess xlReadOnly
             Kill .FullName
             .Close False
         Else
             .CustomDocumentProperties("OpenTimes").Value = Opentimes
             .Save
         End If
     End With
End Sub



程序打开关闭该工作簿超过3次  为什么不实现自杀功能？？？

最佳答案

月排行榜 / 总排行榜

爱疯

2016-8-15 17:41

'自定义文档属性，新增
Sub CustomDocumentProperties()
    Dim cdps, cdp
    Set cdps = ThisWorkbook.CustomDocumentProperties
    For Each cdp In cdps
        If cdp.Name = "OpenTimes" Then Exit Sub
    Next
    cdps.Add Name:="OpenTimes", LinkToContent:=False, Type:=msoPropertyTypeNumber, Value:=0
End Sub


'自定义文档属性，清零
Sub returnToZero()
    ThisWorkbook.CustomDocumentProperties("OpenTimes").Value = 0
End Sub


Private Sub Workbook_Open()
    Dim Opentimes As Integer
    With Me
        Opentimes = .CustomDocumentProperties("OpenTimes").Value + 1
        If Opentimes > 3 Then
            .Saved = True
            .ChangeFileAccess xlReadOnly
            Kill .FullName
            .Close False
        Else
            MsgBox "第" & Opentimes & "次打开"
            .CustomDocumentProperties("OpenTimes").Value = Opentimes
            .Save
        End If
    End With
End Sub

1.rar (15.77 KB, 下载次数: 57)

2016-8-15 17:37 上传

点击文件名下载附件




1）蓝色，如果该自定义属性已存在，则不新增。
2）绿色，手动清零次数。
3）粉色，只为方便查看次数，可以不要。

跳转到最佳答案楼层

秀才遇到兵

忘了发附件了。。。

爱疯

'自定义文档属性，新增
Sub CustomDocumentProperties()
    Dim cdps, cdp
    Set cdps = ThisWorkbook.CustomDocumentProperties
    For Each cdp In cdps
        If cdp.Name = "OpenTimes" Then Exit Sub
    Next
    cdps.Add Name:="OpenTimes", LinkToContent:=False, Type:=msoPropertyTypeNumber, Value:=0
End Sub


'自定义文档属性，清零
Sub returnToZero()
    ThisWorkbook.CustomDocumentProperties("OpenTimes").Value = 0
End Sub


Private Sub Workbook_Open()
    Dim Opentimes As Integer
    With Me
        Opentimes = .CustomDocumentProperties("OpenTimes").Value + 1
        If Opentimes > 3 Then
            .Saved = True
            .ChangeFileAccess xlReadOnly
            Kill .FullName
            .Close False
        Else
            MsgBox "第" & Opentimes & "次打开"
            .CustomDocumentProperties("OpenTimes").Value = Opentimes
            .Save
        End If
    End With
End Sub

1.rar (15.77 KB, 下载次数: 57)

2016-8-15 17:37 上传

点击文件名下载附件




1）蓝色，如果该自定义属性已存在，则不新增。
2）绿色，手动清零次数。
3）粉色，只为方便查看次数，可以不要。

d346836673

学习啦    ！

秀才遇到兵

好了  可以了  谢谢