Excel圖片調(diào)整大小
Sub 圖片調(diào)整合適大小()  
'    Debug.Print ActiveWorkbook.Name  
    圖片顯示比例 = 0.9    '1為頂滿單元格  
    Dim wb As Workbook, sh As Worksheet, ce As Range, shp As Shape  
    Dim dic As Object, re As Object, shel As Object, WS As Object, FSO As Object  
    Dim arr(), brr()    'Redim preserve arr(i)  
    Set dic = CreateObject("scripting.dictionary")  
    Set wb = ActiveWorkbook  
    Set sh = wb.Sheets(1)  
    For Each shp In sh.Shapes  
        With shp  
        shp.Name = shp.Name & Round(Rnd() * 125, 1)  
            shp.Top = shp.Top + shp.Height / 2  
            shp.Left = shp.Left + shp.Width / 2  
            shp.Height = shp.Height / 8    '先縮小圖片,以防出現(xiàn)占據(jù)多個單元格的問題  
            shp.Width = shp.Width / 8  
  
            '.Name = .Name & Rnd(1000)  
            '--------------------------------------------------------------  
            wt = shp.TopLeftCell.MergeArea.Width  '單元格區(qū)域?qū)挾龋? 
            ht = shp.TopLeftCell.MergeArea.Height    '單元格區(qū)域高度  
  
            bl = .Width / .Height  
            If wt / ht < bl Then  
                .Width = wt * 圖片顯示比例  ' sh0.Cells(st_mid2, 1).Width  
                .Height = .Width / bl  
                .Left = shp.TopLeftCell.MergeArea.Left + (wt - .Width) / 2  ' + 2  
                .Top = shp.TopLeftCell.MergeArea.Top + (ht - .Height) / 2  
            Else  
                .Height = ht * 圖片顯示比例  
                .Width = .Height * bl  
                .Top = shp.TopLeftCell.MergeArea.Top + (ht - .Height) / 2  
                .Left = shp.TopLeftCell.MergeArea.Left + (wt - .Width) / 2  
            End If  
        End With  
    Next  
End Sub  

　　

總結(jié)

以上是生活随笔為你收集整理的Excel图片调整大小的全部內(nèi)容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網(wǎng)站內(nèi)容還不錯，歡迎將生活随笔推薦給好友。