Nhờ các cao thủ sửa code ! (3 người xem)

[tranductuyen]

Chào các a, nhờ các a sửa giúp cho phần code này ạ, nội dung yêu cầu e có ghi và viết nhưng không chạy được ạ
Option Explicit

Private allowPrint As Boolean
Private allowFormula As Boolean
Private allowCopySheet As Boolean

Private Const PROTECT_PWD As String = "Pwd123"

Private Sub Workbook_Open()
Dim jsonURL As String
jsonURL = "https://script.googleusercontent.co...lwsmuY9&lib=Mq-Gh-4wYhAp8-zZXlzX5B0vLuPtxMphg"

' 1. Nếu là ngày 01/01/1990 thì bỏ qua kiểm tra
If Date = DateSerial(1990, 1, 1) Then Exit Sub

' 2. Gửi HTTP lấy dữ liệu JSON
Dim http As Object
On Error Resume Next
Set http = CreateObject("MSXML2.XMLHTTP")
On Error GoTo 0

If http Is Nothing Then
MsgBox "Không thể tạo đối tượng HTTP", vbCritical
ThisWorkbook.Close False
Exit Sub
End If

On Error GoTo LoiKetNoi
http.Open "GET", jsonURL, False
http.Send
If http.readyState <> 4 Or http.Status <> 200 Then GoTo LoiKetNoi

' 3. Đọc JSON
Dim jsonText As String
jsonText = http.responseText

Dim moFileFlag As Boolean, printFlag As Boolean, formulaFlag As Boolean, copyFlag As Boolean
moFileFlag = (InStr(jsonText, """moFile1") > 0)
printFlag = (InStr(jsonText, """choPhepIn1") > 0)
formulaFlag = (InStr(jsonText, """xemCongThuc1") > 0)
copyFlag = (InStr(jsonText, """choPhepCopySheet1") > 0)

If Not moFileFlag Then
MsgBox "Bạn không được phép mở file này.", vbCritical
ThisWorkbook.Close False
Exit Sub
End If

' Lưu trạng thái
allowPrint = printFlag
allowFormula = formulaFlag
allowCopySheet = copyFlag

' 4. Áp dụng hạn chế
If Not allowPrint Then
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"", False)"
End If

If Not allowFormula Then
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
sh.Cells.Locked = True
sh.Cells.FormulaHidden = True
On Error Resume Next
sh.Protect Password:=PROTECT_PWD, UserInterfaceOnly:=True
On Error GoTo 0
Next
End If

If Not allowCopySheet Then
ThisWorkbook.Protect Password:=PROTECT_PWD, Structure:=True, Windows:=False
End If

' 5. Lập lịch kiểm tra lại sau 10 phút
Application.OnTime Now + TimeValue("00:10:00"), "Workbook_Open", Schedule:=True
Exit Sub

LoiKetNoi:
MsgBox "Không thể kết nối tới máy chủ để kiểm tra quyền. File sẽ bị đóng.", vbCritical
ThisWorkbook.Close False
End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean)
If Not allowPrint Then
Cancel = True
MsgBox "Bạn không được phép in file này.", vbExclamation
End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI Then
Dim fname As Variant
fname = Application.GetSaveAsFilename(InitialFileName:=ThisWorkbook.Name, _
FileFilter:="Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")

If fname = False Then
Cancel = True
Else
Cancel = True
Application.EnableEvents = False
ThisWorkbook.SaveAs fname, FileFormat:=52
Application.EnableEvents = True
MsgBox "Đã lưu dưới định dạng macro .xlsm", vbInformation
End If
End If
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"", True)"
Application.OnTime Now, "Workbook_Open", , False
End Sub
https://script.google.com/macros/s/...nXbMNxtLVi_0h5CDC-nHQkBWAU79JEXZaD2OTsug/exec

Nội dung	Giá trị	Ghi chú
Cho phép mở file	1	Cho phép/Không cho phép = 1/0
Cho phép in/ không cho phép in (Áp dụng tất cả các sheet)	1	Cho phép/Không cho phép = 1/0
Cho phép xem công thức/ Không cho phép xem công thức (Áp dụng tất cả các sheet)	1	Cho phép/Không cho phép = 1/0
Cho phép/ không cho phép copy hoặc chuyển sheet đến	1	Cho phép/Không cho phép = 1/0

 

[thuytrangbp28]

Bạn sửa lại tiêu đề bỏ chữ "cao thủ" đi, và sửa các từ viết tắt như a, e trong bài viết, đồng thời đính kèm file lên, như vậy sẽ có cơ hội được hỗ trợ nhiều hơn