VBA控制输入内容自动调整列宽快表软件

楼主

Public Sub RangeChanged(sender As Object,e As SpreadsheetGear.Windows.Forms.RangeChangedEventArgs)
'找个单元格定义个别名ZDQY（非数据项），写上需要自动列宽的字段名F_1,F_2
AW.WorkbookSet.GetLock()
if Range("ZDQY") IsNot Nothing Then
Dim QY As String = Range("ZDQY").Cells(0,0).Value.ToString()
DIM QYS As String() = QY.Split(",")
for i=1 to QYS.Length
Dim ZDM As String = QYS(i-1)
if Range(ZDM) IsNot Nothing Then
if e.Range.Intersect(Range(ZDM)) IsNot Nothing AndAlso e.Range.IsEntireColumns=false Then
AW.ActiveWorksheet.ProtectContents = false
e.Range.EntireColumn.Columns.AutoFit()
AW.ActiveWorksheet.ProtectContents = True
End if
End if
Next
End if
AW.WorkbookSet.ReleaseLock()
End Sub'单元格编辑完成后执行事件

复制代码

hessen

赞！

KB_VBA_ZDLK.rar (2.77 KB, 下载次数: 20)

hessen

本帖最后由 hessen 于 2020-9-25 17:18 编辑

规则同上适用于企业版7.5.6以上

ActiveWorkbook.WorkbookSet.GetLock()
'找个单元格定义个别名ZDQY（非数据项），写上需要自动列宽的字段名F_1,F_2
If Range("ZDQY") IsNot Nothing Then
Dim QY As String = Range("ZDQY").Cells(0, 0).Value.ToString()
Dim QYS As String() = QY.Split(",")
Dim i as Integer
For i = 1 To QYS.Length
Dim ZDM As String = QYS(i - 1)
If Range(ZDM) IsNot Nothing Then
If e.Range.Intersect(Range(ZDM)) IsNot Nothing AndAlso e.Range.IsEntireColumns = False Then
ActiveWorkbook.ActiveWorksheet.ProtectContents = False
e.Range.EntireColumn.Columns.AutoFit()
ActiveWorkbook.ActiveWorksheet.ProtectContents = True
End If
End If
Next
End If
ActiveWorkbook.WorkbookSet.ReleaseLock()

复制代码

精彩评论2