Excel单元格插入图片并实现单击放大或缩小功能（含VBA代码）

0 引言

今天有人问我Excel单元格插入图片并实现单（双）击放大的功能该怎么设置，百度和Google了一下，发现大多数是利用插入批注的方式，但不是很方便，后来看到有人用VBA代码实现了这个功能，更加方便和灵活，插入多个图片也没问题。

1 提前准备VBA代码

1.1 ThisWorkbook的代码：

Private Sub Workbook_Open()
    Dim cName$
    On Error Resume Next
    For Each a In Sheet1.Shapes
        If a.Type = 1 Or a.Type = 13 Then
            a.OnAction = "test"
            cName = a.TopLeftCell.Address(0,0)
            Do
                a.Name = cName
                If Err = 0 Then Exit Do
                cName = cName & "_0"
                Err.Clear
            Loop
        End If
    Next
End Sub

1.2 模块的代码：

Sub test()
    On Error Resume Next
    For Each a In Sheet1.Shapes
        If a.Type = 1 Or a.Type = 13 Then
            If a.Name = Application.Caller And a.AlternativeText = Empty Then
                a.AlternativeText = a.Height & Chr(28) & a.Width
                a.Height = a.Width * 3
                a.Width = a.Width * 3
                a.ZOrder msoBringToFront
            Else
                a.Height = Split(a.AlternativeText, Chr(28))(0)
                a.Width = Split(a.AlternativeText, Chr(28))(1)
                a.AlternativeText = Empty
            End If
            Err.Clear
        End If
    Next
End Sub

模块的代码，其中第7，8行的数字可以改成其他，这个是高和宽的放大倍数，此处是3倍；

当然：
还有一张或多张图片。。。

2 设置步骤

2.1 VBA代码设置单元格

打开Excel，我用的是Excel2019，选中需要插入图片的单元格，摁下键盘的 ALT + F11，打开 VBA编辑器如下：

然后，双击ThisWorkbook，复制 1.1 ThisWorkbook的代码，如下：

复制完代码以后关闭工作簿1（代码自动保存了），在ThisWorkbook下方的空白处右键，选中插入–>模块，如下打开模块代码编辑：

然后复制 1.2 模块的代码，如下：

然后关闭工作簿-模块1（代码自动保存了），两个代码都用了，也关闭VBA编辑器；

到这里，已经完成一大步，对单元格完成了VBA代码的设置；

2.2 插入图片到单元格

选中单元格，Excel菜单栏插入图片，选择要插入的图片（多个图片可以多选），如下：

插入图片后，用鼠标调整图片大小到单元格内，再利用菜单栏格式–>对齐（网格对齐）[多张图需要用到左对齐等对齐]，使图片填充到单元格内，如下：

接下来这一步能保证单击放大的图片够清晰，利用菜单栏格式–>压缩图片，分辨率选择高保真，如下：（这里我换了张图，因为我这里高保真灰色不可选，结果换了图还是不可选，就选了HD，尴尬。。。）

2.3 以启用宏的方式保存图片

最后，尝试单击或双击图片并没有放大，是因为需要先保存再打开才行，因为VBA代码设置的宏还没生效。所以 ctrl + s，保存图片，文件名随便，但保存类型要选择Excel启用宏的工作簿，如下：

再次打开保存的文件，发现如下图的安全警告 宏已被禁用，点击 启用内容 就行了，尝试单击图片实现放大效果（选择HD，放大有颗粒感，高保真应该会更好。。。），再次单击放大图片或其他单元格，实现缩小图片，如下：