當(dāng)前位置：首頁 > 编程资源 > 编程问答 >内容正文

编程问答

EXCEL VBA 导入图片自适应大小

發(fā)布時間：2025/3/20 编程问答 14 豆豆

生活随笔收集整理的這篇文章主要介紹了 EXCEL VBA 导入图片自适应大小小編覺得挺不錯的,現(xiàn)在分享給大家,幫大家做個參考.

? Sub into_pic()

? ? On Error Resume Next???????????'忽略錯誤繼續(xù)執(zhí)行VBA代碼,避免出現(xiàn)錯誤消息

? ? '圖片路徑

? ? pic_url = "d:\我的文檔\桌面\"

? ? '圖片所在的列

? ? pic_column_num = "C"

? ? '圖片寬度

? ? pic_width = 100

? ? '圖片高度

? ? pic_height = 100

? ? '表格寬度

? ? Range_width = 22

? ? '表格高度

? ? Range_Height = 100

? ? '款號所在起始的列

? ? k_id_column_start_num = "A"

? ? '顏色所在起始的列

? ? k_color_column_start_num = "B"

? ? '款號所在起始的行

? ? k_id_column_start_row = 2

? ? For i = k_id_column_start_row To 65535

? ? buffer_val = Range(k_id_column_start_num & i).Value

? ? buffer_color_val = Range(k_color_column_start_num & i).Value

? ? If buffer_val <> "" Then

? ? ActiveSheet.Range(pic_column_num & i).Select

? ? pic_urls = pic_url & "\" & buffer_val & buffer_color_val & ".jpg"

? ? cColumn = ActiveCell.Column '所在列數(shù)

? ? rRow = ActiveCell.Row '所在行數(shù)

? ? 'MsgBox (cColumn)

? ? 'MsgBox (rRow)

? ? 'Rows(i & ":" & i).RowHeight = Range_Height

? ? 'Columns(pic_column_num & ":" & pic_column_num).ColumnWidth = Range_width

? ? ' With ActiveSheet.Pictures.Insert(pic_urls)

? ? With Sheets("Sheet1").Pictures.Insert(pic_urls)?'可用

? ? .ShapeRange.LockAspectRatio = msoFalse

? ? .Placement = xlMoveAndSize

? ? '.ShapeRange.Top = Selection.Top

? ? '.ShapeRange.Left = Selection.Left

? ? .ShapeRange.Left = Range(pic_column_num & i).Left

? ? .ShapeRange.Top = Range(pic_column_num & i).Top

? ? '.ShapeRange.Width = pic_width

? ? '.ShapeRange.Height = pic_height

? ? '.ShapeRange.Height = Range(pic_column_num & i).Height

? ? .ShapeRange.Height = Range(pic_column_num & i).Height

? ? .ShapeRange.Width = Range(pic_column_num & i).Width

? ? ''''''''''''''''''''''''''

? ? '??Sub Test()

? ? '????????With Sheets("Sheet1").Pictures.Insert("d:\我的文檔\桌面\52058.JPG ")?'可用

? ? '??????????????????.ShapeRange.LockAspectRatio = msoFalse

? ? '??????????????????.Placement = xlMoveAndSize

? ? '??????????????????.ShapeRange.Left = Range("b2 ").Left

? ? '??????????????????.ShapeRange.Top = Range("b2 ").Top

? ? '??????????????????.ShapeRange.Height = Range("b2:b5 ").Height

? ? '??????????????????.ShapeRange.Width = Range("b2:c2 ").Width

? ? '??????????End With

? ? '??End Sub

? ? ''''''''''''''''''''''''''

? ? End With

? ? End If

? ? Next i

? ? End Sub

? ? 早期的文件代碼，不自動縮放

? ? Sub into_pic()

? ? On Error Resume Next???????????'忽略錯誤繼續(xù)執(zhí)行VBA代碼,避免出現(xiàn)錯誤消息

? ? '圖片路徑

? ? pic_url = "d:\我的文檔\桌面\mu\pic"