Excel VBA：如何动态放大/展开 ActiveCell？

Question

我在一个 facebook 群组中遇到了一个问题，该问题询问如何在 Excel 工作表中展开/放大/缩放活动单元格。 通常，我不喜欢在视觉上弄乱 Excel UI，但我猜这个人一定有某种形式的视觉障碍，或者需要对活动单元格的内容有一个清晰和更大的视图。 我在 stackoverflow 和谷歌搜索以及类似的问题框中进行了搜索，但没有显示我正在搜索的完全相同的答案。 我相信这个问题有多种可能的方法。 1.改变activecell的rowHeight和columnWidth。

Application.ActiveCell.RowHeight=50
Application.ActiveCell.ColumnWidth=50

2.改变包含activecell的列的自动调整。

Application.ActiveCell.EntireColumn.AutoFit

3.改变活动窗口的缩放级别。

ActiveWindow.Zoom 50

4. 将活动单元格内容分配给无模式用户窗体上的 textbox.text 属性。 我认为方法 1 和 4 最有可能奏效，我个人更喜欢方法 4，因为它似乎不太可能在视觉上打扰用户。

Workbook_SheetSelectionChange "event will be used

Answer 1

请允许我使用以下 VBA 代码回答我自己的问题。
请随时对此进行改进。

'copy paste into ThisWorkbook module
'explicit error checking was not performed - use at users' own risk
Option Explicit

Const increasedColumnWidth = 50'change how large as per requirement
Const increasedRowHeight = 50

'saved properties to restore later
Private saved_ActiveCell_ColumnWidth As Integer
Private saved_ActiveCell_RowHeight As Integer
Private saved_ActiveCell As Range

'can also be placed into individual worksheet modules but used ThisWorkbook to cover newly inserted sheets
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'very important that sh must be a worksheet<-not checked here
'    If Sh.Name = "Sheet1" Then 'set sheet name here to limit to Sheet1 only or any particular sheet
    If Target.Cells.CountLarge = 1 Then 'if .Count, there may be overflow
        Application.ScreenUpdating = False 'to reduce flashing
        If Target.Value <> "" Then 'or isempty(target.value)
            'restoring previous activecell if there's one
            If Not saved_ActiveCell Is Nothing Then
                saved_ActiveCell.EntireColumn.ColumnWidth = saved_ActiveCell_ColumnWidth
                saved_ActiveCell.EntireRow.RowHeight = saved_ActiveCell_RowHeight
            End If
            'backup
            Set saved_ActiveCell = Target 'Application.ActiveCell
            saved_ActiveCell_ColumnWidth = Target.ColumnWidth
            saved_ActiveCell_RowHeight = Target.RowHeight
            'expanding
            Target.EntireRow.RowHeight = increasedRowHeight
            Target.EntireColumn.ColumnWidth = increasedColumnWidth
        Else'if activecell doesn't contain any value, restore previous activecell to previous size
            If Not saved_ActiveCell Is Nothing Then
                saved_ActiveCell.EntireColumn.ColumnWidth = saved_ActiveCell_ColumnWidth
                saved_ActiveCell.EntireRow.RowHeight = saved_ActiveCell_RowHeight
            End If
        End If
        Application.ScreenUpdating = True
    End If
'    End If
End Sub

分享此代码并不意味着我支持搞乱 Excel UI 操作，尤其是那些会打扰用户的操作。
提供的代码仅用于更改 activecell 的 rowHeight 和 columnWidth 以向用户提供 activecell 展开/放大的视觉效果。
我见过其他代码可以即时创建 activecell 的图像，并给用户带来缩放单元格here 的印象。

此处分享的代码仅用于操作ActiveCell的rowHeight和columnWidth。
在无模式用户窗体上处理文本框的方法仍在改进中，最终将（可能）在我的GitHub 上以 .xlsm 文件的形式提供。
还在下面上传了一个.gif，以清楚地显示要求和结果。
此视频 .gif 包含此处共享的代码中不可用的功能。