ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 1673|回复: 5

[求助] 使用VBA代码禁止修改行高和列宽

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-12-18 15:23 | 显示全部楼层 |阅读模式
使用VBA代码禁止修改行高和列宽,虽然保护工作表可以实现我要的功能,但保护工作表还会带来一些麻烦,所以想通过VBA代码实现。
先表感谢!

用VBA代码禁止修改行高和列宽.rar

6.78 KB, 下载次数: 28

头像被屏蔽

TA的精华主题

TA的得分主题

发表于 2019-12-19 09:57 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-12-19 12:10 | 显示全部楼层
朱荣兴 发表于 2019-12-19 09:57
仅供参考,如果选定整行或者整列,则无法选定
Private Sub Worksheet_SelectionChange(ByVal Target As Ra ...

测试了,但没有效果呢

TA的精华主题

TA的得分主题

发表于 2019-12-19 12:15 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
下面代码是你修改行高和列宽后,回变回原来的。
  1. Dim arr()
  2. Dim LastSelection As String

  3. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  4.     Dim sAddress As String, RowCnt%, ColCnt%
  5.     sAddress = Target.Address(0, 0)

  6.     If LastSelection <> "" Then
  7.         For i = 1 To UBound(arr)
  8.             If LastSelection = "R" Then Rows(arr(i, 1)).RowHeight = arr(i, 2)
  9.             If LastSelection = "C" Then Columns(arr(i, 1)).ColumnWidth = arr(i, 2)
  10.         Next
  11.     End If

  12.     If Target.EntireRow.Address = Target.Address Then
  13.         LastSelection = "R"
  14.         RowCnt = Target.Rows.Count
  15.         ReDim arr(1 To RowCnt, 1 To 2)
  16.         For i = 1 To UBound(arr)
  17.             With Target.Resize(1).Offset(i - 1)
  18.                 arr(i, 1) = .Row
  19.                 arr(i, 2) = .RowHeight
  20.             End With
  21.         Next
  22.     End If
  23.    
  24.     If Target.EntireColumn.Address = Target.Address Then
  25.         LastSelection = "C"
  26.         RowCnt = Target.Columns.Count
  27.         ReDim arr(1 To RowCnt, 1 To 2)
  28.         For i = 1 To UBound(arr)
  29.             With Target.Resize(1).Offset(, i - 1)
  30.                 arr(i, 1) = .Column
  31.                 arr(i, 2) = .ColumnWidth
  32.             End With
  33.         Next
  34.     End If
  35. End Sub
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-12-19 12:22 | 显示全部楼层
或者下面代码,选择整行或整列时,自动保护工作表,否则取消保护:
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     If Target.EntireRow.Address = Target.Address Or Target.EntireColumn.Address = Target.Address Then
  3.         ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
  4.         False, AllowFormattingCells:=True, AllowInsertingColumns:=True, _
  5.         AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _
  6.         AllowDeletingColumns:=True, AllowDeletingRows:=True, AllowSorting:=True, _
  7.         AllowFiltering:=True, AllowUsingPivotTables:=True
  8.     Else
  9.         ActiveSheet.Unprotect
  10.     End If
  11. End Sub
复制代码

评分

2

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-12-19 13:06 | 显示全部楼层
mzbao 发表于 2019-12-19 12:22
或者下面代码,选择整行或整列时,自动保护工作表,否则取消保护:

应该会用到,先Mark 一下
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-28 23:45 , Processed in 0.046535 second(s), 11 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表