VBA UnProtect & Protect sheet
Posted: Tue May 30, 2017 11:00 am
ได้ทำ input sheet ให้ผู้ใช้ใส่ข้อมูล จึงต้องการ protect บาง cell ที่มีสูตรไว้ไม่ให้แก้ไขได้
และเหลือบาง cell สำหรับใส่ หรือ เลือกข้อมูล
การ protect sheet โดยเลือก Edit Objects ไว้ด้วย เพื่อให้ Combo box ที่มี vba ทำงาน
และการเลือกส่วนที่จะให้ใส่ data จะได้ข้อมูลดิบเพื่อไปทำตาราง Pivot table เพื่อหาข้อมูลซ้ำและรวมผลจำนวน
การ Refresh ข้อมูล Pivot table กับการล็อก sheet ต้องเอา VBA มาช่วย (โดยผมสร้างปุ่มขึ้นมาเพื่อเป็นการกดอัปเดต)
แต่เมื่อกดอัปเดตแล้ว Combo box ที่มี vba ไม่สามารถทำงานได้ตามปกติ
(พอผมไปดูจากการที่เราเลือก Edit objects ในตอนที่เรา Protect Edit objects ไม่มีการเลือกอยู่
ซึ่งอาจส่งผมมาจากการที่เราเขียน Code Unprotect และให้ Refresh Pivottable และกลับไป Protect อีกครั้ง
ผมว่าตอนที่ไป Protect อีกครั้งอะครับคงไม่ได้เลือก Edit Object ไว้เหมือนเดิม
ปัญหาแบบนี้ผมต้องแก้ยังไงอะครับ
Code VBA ทั้งหมดที่ผมใช้อยู่ครับ
Private Sub CommandButton1_Click()
ActiveSheet.Unprotect "Secret"
ActiveSheet.PivotTables("pivotTable1").PivotCache.Refresh
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="Secret"
End Sub
Private Sub CommandButton2_Click()
ActiveSheet.Unprotect "Secret"
ActiveSheet.PivotTables("pivotTable2").PivotCache.Refresh
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="Secret"
End Sub
'==========================
Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, _
Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim WS As Worksheet
Set WS = ActiveSheet
Set cboTemp = WS.OLEObjects("TempCombo")
On Error Resume Next
With cboTemp
'clear and hide the combo box
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
'if the cell contains
'a data validation list
Cancel = True
Application.EnableEvents = False
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
'for simple INDIRECT function (English)
' e.g. =INDIRECT(substitute(B2,"","_"))
'will create dependent list of items
If Left(str, 8) = "INDIRECT" Then
lSplit = InStr(1, str, "(")
str = Right(str, Len(str) - lSplit)
str = Left(str, Len(str) - 1)
str = Range(str).Value
End If
With cboTemp
'show the combobox with the list
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 5
.Height = Target.Height + 5
.ListFillRange = str
.LinkedCell = Target.Address
End With
cboTemp.Activate
'open the drop down list automatically
Me.Tempcombo.DropDown
End If
errHandler:
Application.EnableEvents = True
Exit Sub
End Sub
'=========================================
Private Sub TempCombo_LostFocus()
With Me.Tempcombo
.Top = 10
.Left = 10
.Width = 0
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
.Value = ""
End With
End Sub
'====================================
และเหลือบาง cell สำหรับใส่ หรือ เลือกข้อมูล
การ protect sheet โดยเลือก Edit Objects ไว้ด้วย เพื่อให้ Combo box ที่มี vba ทำงาน
และการเลือกส่วนที่จะให้ใส่ data จะได้ข้อมูลดิบเพื่อไปทำตาราง Pivot table เพื่อหาข้อมูลซ้ำและรวมผลจำนวน
การ Refresh ข้อมูล Pivot table กับการล็อก sheet ต้องเอา VBA มาช่วย (โดยผมสร้างปุ่มขึ้นมาเพื่อเป็นการกดอัปเดต)
แต่เมื่อกดอัปเดตแล้ว Combo box ที่มี vba ไม่สามารถทำงานได้ตามปกติ
(พอผมไปดูจากการที่เราเลือก Edit objects ในตอนที่เรา Protect Edit objects ไม่มีการเลือกอยู่
ซึ่งอาจส่งผมมาจากการที่เราเขียน Code Unprotect และให้ Refresh Pivottable และกลับไป Protect อีกครั้ง
ผมว่าตอนที่ไป Protect อีกครั้งอะครับคงไม่ได้เลือก Edit Object ไว้เหมือนเดิม
ปัญหาแบบนี้ผมต้องแก้ยังไงอะครับ
Code VBA ทั้งหมดที่ผมใช้อยู่ครับ
Private Sub CommandButton1_Click()
ActiveSheet.Unprotect "Secret"
ActiveSheet.PivotTables("pivotTable1").PivotCache.Refresh
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="Secret"
End Sub
Private Sub CommandButton2_Click()
ActiveSheet.Unprotect "Secret"
ActiveSheet.PivotTables("pivotTable2").PivotCache.Refresh
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="Secret"
End Sub
'==========================
Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, _
Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim WS As Worksheet
Set WS = ActiveSheet
Set cboTemp = WS.OLEObjects("TempCombo")
On Error Resume Next
With cboTemp
'clear and hide the combo box
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
'if the cell contains
'a data validation list
Cancel = True
Application.EnableEvents = False
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
'for simple INDIRECT function (English)
' e.g. =INDIRECT(substitute(B2,"","_"))
'will create dependent list of items
If Left(str, 8) = "INDIRECT" Then
lSplit = InStr(1, str, "(")
str = Right(str, Len(str) - lSplit)
str = Left(str, Len(str) - 1)
str = Range(str).Value
End If
With cboTemp
'show the combobox with the list
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 5
.Height = Target.Height + 5
.ListFillRange = str
.LinkedCell = Target.Address
End With
cboTemp.Activate
'open the drop down list automatically
Me.Tempcombo.DropDown
End If
errHandler:
Application.EnableEvents = True
Exit Sub
End Sub
'=========================================
Private Sub TempCombo_LostFocus()
With Me.Tempcombo
.Top = 10
.Left = 10
.Width = 0
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
.Value = ""
End With
End Sub
'====================================