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. 重複以上步驟，直到所有圖片大小和位置都適應單元格

這種方式雖然比較繁瑣，但對於插入數量不大的圖片，仍然是一種可行的方式。