代码修改

wjdcpa

Sub UnprotectOnlyWhiteCells()
    Dim ws As Worksheet
    Dim cell As Range
    Dim protectPassword As String
    Dim whiteColor As Long

    ' 设置保护密码，如果之前没有设置过，可以为空字符串
    protectPassword = "" ' 你的保护密码，如果没有则留空
    ' 设置白色背景的RGB代码
    whiteColor = RGB(255, 255, 255)

    Set ws = ActiveSheet ' 操作当前活动的工作表

    ' 撤销工作表保护
    ws.Unprotect Password:=protectPassword

    ' 先设置所有单元格为未锁定
    ws.Cells.Locked = False

    ' 遍历工作表中的每个单元格
    For Each cell In ws.UsedRange
        ' 如果单元格的背景颜色不是白色，则锁定该单元格
        If cell.Interior.Color <> whiteColor Then
            cell.Locked = True
        End If
    Next cell

    ' 重新保护工作表

ws.Protect Password:=protectPassword, userInterfaceOnly:=True, AllowFiltering:=True, DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingRows:=True

End Sub

上面代码中红色的那条不同通过，请教应如何修改，谢谢！

ykcbf1100

可以上传附件看看

ynzsvt

1. protectPassword = "y" ' 你的保护密码，如果没有则留空

复制代码

代码没错，你只要知道这个正确的密码然后换上即可。

wjdcpa

ykcbf1100 发表于 2024-10-5 18:50
可以上传附件看看

请见附件，谢谢！

ynzsvt

只改了合并的lock的主体

1. Sub UnprotectOnlyWhiteCellsInPrintArea()
   
2. Dim ws As Worksheet
   
3. Dim cell As Range
   
4. Dim protectPassword As String
   
5. Dim whiteColor As Long
   
6. Dim printAreaRange As Range
   
7. 
   
8. ' 设置保护密码，如果之前没有设置过，可以为空字符串
   
9. protectPassword = "" ' 你的保护密码，如果没有则留空
   
10. ' 设置白色背景的RGB代码
    
11. whiteColor = RGB(255, 255, 255)
    
12. 
    
13. Set ws = ActiveSheet ' 操作当前活动的工作表
    
14. 
    
15. ' 撤销工作表保护
    
16. ws.Unprotect Password:=protectPassword
    
17. 
    
18. ' 获取打印区域
    
19. If ws.PageSetup.PrintArea <> "" Then
    
20.   Set printAreaRange = ws.Range(ws.PageSetup.PrintArea)
    
21.   ' 遍历打印区域的每个单元格
    
22.   For Each cell In printAreaRange
    
23.    If cell.MergeCells Then
    
24.     ' 如果是合并单元格，只处理左上角单元格
    
25.     If cell.Address = cell.MergeArea.Cells(1, 1).Address Then
    
26.      If cell.Interior.Color = whiteColor Then
    
27.       cell.MergeArea.Locked = False
    
28.      Else
    
29.       cell.MergeArea.Locked = True
    
30.      End If
    
31.     End If
    
32.    Else
    
33.     ' 如果单元格的背景颜色是白色，则解锁该单元格
    
34.     If cell.Interior.Color = whiteColor Then
    
35.      cell.Locked = False
    
36.     Else
    
37.      cell.Locked = True
    
38.     End If
    
39.    End If
    
40.   Next cell
    
41. Else
    
42.   ' 如果没有设置打印区域，则不进行操作
    
43.   MsgBox "没有设置打印区域。"
    
44.   Exit Sub
    
45. End If
    
46. 
    
47. ' 重新保护工作表
    
48. ws.Protect Password:=protectPassword, DrawingObjects:=True, Contents:=True, Scenarios:=True
    
49. End Sub

复制代码

wjdcpa

ynzsvt 发表于 2024-10-6 19:15
只改了合并的lock的主体

谢谢老师！