Excel批量插图片自适应大小

一、Excel批量插入图片自适应大小

在使用Excel表格的过程中，我们经常需要在表格中插入图片来辅助展示数据，但常常会遇到图片过大或过小，需要手动调整大小的情况，这对于大量图片插入的情况下需要花费大量的时间和精力。下面我们介绍一种自适应大小的方式来批量插入图片。

Sub InsertPic()
    Dim picName As String '图片名
    Dim picPath As String '图片路径
    Dim picWidth As Single '图片实际宽度
    Dim picHeight As Single '图片实际高度
    Dim picRatio As Single '图片宽高比
    
    '打开“打开文件”对话框，选择要插入的图片文件
    picPath = Application.GetOpenFilename("JPG Files *.jpg,*.png,*.bmp", , "Select Picture")
    
    '如果选择了图片文件
    If picPath  "False" Then
        '提取图片名
        picName = Mid(picPath, InStrRev(picPath, "\") + 1)
        '插入图片
        With ActiveSheet.Pictures.Insert(picPath)
            '获取图片的实际宽度和高度
            picWidth = .Width
            picHeight = .Height
            '计算图片的宽高比
            picRatio = picWidth / picHeight
            '自适应表格宽度
            If picWidth > ActiveCell.Width Then
                .Width = ActiveCell.Width - 10
                .Height = (.Width / picRatio)
            End If
            '自适应表格高度
            If picHeight > ActiveCell.RowHeight Then
                .Height = ActiveCell.RowHeight - 5
                .Width = (.Height * picRatio)
            End If
            '移动图片到单元格中心
            .Left = ActiveCell.Left + (ActiveCell.Width - .Width) / 2
            .Top = ActiveCell.Top + (ActiveCell.RowHeight - .Height) / 2
            '重命名图片
            .Name = picName
        End With
    End If
End Sub

上述代码中通过打开“打开文件”对话框，选择要插入的图片文件，并通过计算图片的实际宽度和高度，计算出图片的宽高比，从而使图片能够自适应表格大小。

二、Excel批量插图片自适应大小宏

如果需要在多个单元格中批量插入图片，并且需要保持图片自适应表格大小，那么我们可以通过编写宏来实现。下面是一个简单的批量插入图片自适应大小的示例宏：

Sub InsertPicsAuto()
    Dim picName As String
    Dim picPath As String
    Dim picWidth As Single
    Dim picHeight As Single
    Dim picRatio As Single
    Dim cell As Range
    
    '打开“打开文件”对话框，选择要插入的图片文件
    picPath = Application.GetOpenFilename("JPG Files *.jpg,*.png,*.bmp", , "Select Pictures")
    
    '如果选择了图片文件
    If picPath  "False" Then
        For Each cell In Selection
            '提取图片名
            picName = Mid(picPath, InStrRev(picPath, "\") + 1)
            '插入图片
            With ActiveSheet.Pictures.Insert(picPath)
                '获取图片的实际宽度和高度
                picWidth = .Width
                picHeight = .Height
                '计算图片的宽高比
                picRatio = picWidth / picHeight
                '自适应表格宽度
                If picWidth > cell.Width Then
                    .Width = cell.Width - 10
                    .Height = (.Width / picRatio)
                End If
                '自适应表格高度
                If picHeight > cell.RowHeight Then
                    .Height = cell.RowHeight - 5
                    .Width = (.Height * picRatio)
                End If
                '移动图片到单元格中心
                .Left = cell.Left + (cell.Width - .Width) / 2
                .Top = cell.Top + (cell.RowHeight - .Height) / 2
                '重命名图片
                .Name = picName
            End With
            '向右移动一列
            Set cell = cell.Offset(0, 1)
        Next cell
    End If
End Sub

上述代码通过打开“打开文件”对话框，选择要插入的多个图片文件，并通过循环迭代选择区域中的单元格，实现批量插入图片并自适应表格大小。

三、Excel批量插图片自适应大小WPS

如果您使用WPS表格而非Excel表格，您也可以使用类似的方法实现自适应大小的图片插入。以下是一个示例宏：

Sub InsertPicWPS()
    Dim picName As String
    Dim picPath As String
    Dim picWidth As Single
    Dim picHeight As Single
    Dim picRatio As Single
    
    '打开“打开文件”对话框，选择要插入的图片文件
    picPath = Application.GetOpenFilename("JPG Files *.jpg,*.png,*.bmp", , "Select Picture")
    
    '如果选择了图片文件
    If picPath  "False" Then
        '提取图片名
        picName = Mid(picPath, InStrRev(picPath, "\") + 1)
        '插入图片
        With ActiveSheet.Pictures.Insert(picPath)
            '获取图片的实际宽度和高度
            picWidth = .Width
            picHeight = .Height
            '计算图片的宽高比
            picRatio = picWidth / picHeight
            '自适应表格宽度
            If picWidth > ActiveCell.Width Then
                .Width = ActiveCell.Width - 10
                .Height = (.Width / picRatio)
            End If
            '自适应表格高度
            If picHeight > ActiveCell.RowHeight Then
                .Height = ActiveCell.RowHeight - 5
                .Width = (.Height * picRatio)
            End If
            '移动图片到单元格中心
            .Left = ActiveCell.Left + (ActiveCell.Width - .Width) / 2
            .Top = ActiveCell.Top + (ActiveCell.RowHeight - .Height) / 2
            '重命名图片
            .Name = picName
        End With
    End If
End Sub

与Excel表格的示例相似，上述代码中通过打开“打开文件”对话框，选择要插入的图片文件，并通过计算图片的实际宽度和高度，计算出图片的宽高比，从而使图片能够自适应表格大小。

四、Excel表格内图片统一大小

除了在插入图片时自适应表格大小，我们也可以通过其他方式来实现表格内图片的统一大小。以下是一种比较简单的方式：

1. 选中要统一图片大小的一列单元格
2. 点击“开始”选项卡中的“格式刷”按钮
3. 在“格式刷”模式下，选中已经设置好大小的图片，并取消选中单元格
4. 点击“开始”选项卡中的“粘贴”按钮
5. 在“粘贴”模式下，选择要统一大小的图片，并完成粘贴操作
6. 选中刚刚插入的图片，并调整其大小和位置以适应单元格
7. 重复以上步骤，直到所有图片大小和位置都适应单元格

这种方式虽然比较繁琐，但对于插入数量不大的图片，仍然是一种可行的方式。