你能帮我把这两个代码加在一起吗?我需要将它们放在Workbook模块中,但我一直在调试"编译错误:当前范围内的重复声明"用线",ws As String" (在第二个代码中)和子工作簿打开()以黄色突出显示。
第一个代码是:
Private Sub Workbook_Open()
Dim sh As Integer, c As Integer
Dim rng As Range
Dim UsersName As String, ws As String
Dim m As Variant
Dim wsUsers As Worksheet
'hide all but first sheet
For sh = 2 To Worksheets.Count
Worksheets(sh).Visible = xlSheetVeryHidden
Next sh
Set wsUsers = Worksheets("Users")
Set rng = wsUsers.Range(wsUsers.Range("A1"), wsUsers.Range("A" &
wsUsers.Rows.Count).End(xlUp))
UsersName = Environ("USERNAME")
m = Application.Match(UsersName, rng, False)
On Error GoTo myerror
If Not IsError(m) Then
If CBool(wsUsers.Cells(Val(m), 2).Value) Then
'admin user
For sh = 2 To Worksheets.Count
Worksheets(sh).Visible = xlSheetVisible
Next sh
Else
'show users sheet(s)
c = 3
Do
ws = CStr(wsUsers.Cells(Val(m), c).Text)
If Len(ws) = 0 Then Exit Do
Worksheets(ws).Visible = xlSheetVisible
c = c + 1
Loop
End If
Else
MsgBox "You Do Not Have Authorised Access To This Workbook.", 16, "No
Access"
End If
myerror:
If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub
第二个代码是:
Option Explicit
Public sTxtBoxPassw As String
Private Const ADMIN_PASSWORD As String = "ADMIN" 'change passwords as
required.
Private Const WORKSHEET_PASSWORD As String = "password"
Private bRangeEdited As Boolean
Private bAdmin As Boolean
Private WithEvents ws As Worksheet
Private WithEvents ChckBx As MSForms.CheckBox
Private Sub Workbook_Open()
With Range("InputRange")
Set ws = .Parent
Set ChckBx = .Parent.CheckBox1
ChckBx.Caption = "Adminitrator"
ChckBx.Value = False
End With
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
Dim sMSG As String
sMSG = "saving the workbook will lock the cells in the 'InputRange' ." &
vbLf
sMSG = sMSG & "Do you want to go ahead ?"
If Not bRangeEdited Or bAdmin Then GoTo Xit
If Not ReadOnly Then
With Range("InputRange")
If MsgBox(sMSG, vbExclamation + vbYesNo) = vbNo Then
Cancel = True
GoTo Xit
End If
.Parent.Unprotect WORKSHEET_PASSWORD
If .SpecialCells(xlCellTypeBlanks).Address <> .Address Then
.SpecialCells(xlCellTypeConstants).Locked = True
bRangeEdited = False
End If
.Parent.Protect WORKSHEET_PASSWORD
End With
End If
Xit:
End Sub
Private Sub ws_Change(ByVal Target As Range)
If Not Intersect(Range("InputRange"), Target) Is Nothing Then
bRangeEdited = True
End If
End Sub
Private Sub ChckBx_Change()
With ChckBx
Select Case .Value
Case True
If EnterAdminPassword = UCase(ADMIN_PASSWORD) Then
bAdmin = True
Range("InputRange").Parent.Unprotect WORKSHEET_PASSWORD
Else
ChckBx.Value = False
MsgBox "Wrong Adim Password", vbCritical
End If
Case Else
bAdmin = False
Range("InputRange").Parent.Protect WORKSHEET_PASSWORD
End Select
End With
End Sub
Private Function EnterAdminPassword() As String
UserForm1.Show vbModal
EnterAdminPassword = UCase(sTxtBoxPassw)
End Function
非常感谢任何帮助。我遇到了这个article,但我对VBA不是很了解,所以我无法理解它
@SvenRasmussen:这是我的最终组合。然而,它在Set ChckBx = .Parent.CheckBox1行进行调试。
Option Explicit
Public sTxtBoxPassw As String
Private Const ADMIN_PASSWORD As String = "ADMIN" 'change passwords as
required.
Private Const WORKSHEET_PASSWORD As String = "password"
Private bRangeEdited As Boolean
Private bAdmin As Boolean
Private WithEvents ws As Worksheet
Private WithEvents ChckBx As MSForms.CheckBox
Private Sub Workbook_Open()
With Range("InputRange")
Set ws = .Parent
Set ChckBx = .Parent.CheckBox1
ChckBx.Caption = "Administrator"
ChckBx.Value = False
End With
Dim sh As Integer, c As Integer
Dim rng As Range
Dim UsersName As String, differentString As String
Dim m As Variant
Dim wsUsers As Worksheet
'hide all but first sheet
For sh = 2 To Worksheets.Count
Worksheets(sh).Visible = xlSheetVeryHidden
Next sh
Set wsUsers = Worksheets("Users")
Set rng = wsUsers.Range(wsUsers.Range("A1"), wsUsers.Range("A" &
wsUsers.Rows.Count).End(xlUp))
UsersName = Environ("USERNAME")
m = Application.Match(UsersName, rng, False)
On Error GoTo myerror
If Not IsError(m) Then
If CBool(wsUsers.Cells(Val(m), 2).Value) Then
'admin user
For sh = 2 To Worksheets.Count
Worksheets(sh).Visible = xlSheetVisible
Next sh
Else
'show users sheet(s)
c = 3
Do
differentString = CStr(wsUsers.Cells(Val(m), c).Text)
If Len(differentString) = 0 Then Exit Do
Worksheets(differentString).Visible = xlSheetVisible
c = c + 1
Loop
End If
Else
MsgBox "You Do Not Have Authorised Access To This Workbook.", 16, "No
Access"
End If
myerror:
If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
Dim sMSG As String
sMSG = "saving the workbook will lock the cells in the 'InputRange' ." &
vbLf
sMSG = sMSG & "Do you want to go ahead ?"
If Not bRangeEdited Or bAdmin Then GoTo Xit
If Not ReadOnly Then
With Range("InputRange")
If MsgBox(sMSG, vbExclamation + vbYesNo) = vbNo Then
Cancel = True
GoTo Xit
End If
.Parent.Unprotect WORKSHEET_PASSWORD
If .SpecialCells(xlCellTypeBlanks).Address <> .Address Then
.SpecialCells(xlCellTypeConstants).Locked = True
bRangeEdited = False
End If
.Parent.Protect WORKSHEET_PASSWORD
End With
End If
Xit:
End Sub
Private Sub ws_Change(ByVal Target As Range)
If Not Intersect(Range("InputRange"), Target) Is Nothing Then
bRangeEdited = True
End If
End Sub
Private Sub ChckBx_Change()
With ChckBx
Select Case .Value
Case True
If EnterAdminPassword = UCase(ADMIN_PASSWORD) Then
bAdmin = True
Range("InputRange").Parent.Unprotect WORKSHEET_PASSWORD
Else
ChckBx.Value = False
MsgBox "Wrong Adim Password", vbCritical
End If
Case Else
bAdmin = False
Range("InputRange").Parent.Protect WORKSHEET_PASSWORD
End Select
End With
End Sub
Private Function EnterAdminPassword() As String
UserForm1.Show vbModal
EnterAdminPassword = UCase(sTxtBoxPassw)
End Function