Sub into_pic()On Error Resume Next '忽略错误继续执行VBA代码,避免出现错误消息
'图片路径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 65535buffer_val = Range(k_id_column_start_num & i).Valuebuffer_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 '所在列数 rRow = ActiveCell.Row '所在行数 '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 IfNext iEnd Sub
早期的文件代码，不自动缩放
Sub into_pic()On Error Resume Next '忽略错误继续执行VBA代码,避免出现错误消息
'图片路径 www.2cto.compic_url = "d:\我的文档\桌面\mu\pic"'图片所在的列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 65535buffer_val = Range(k_id_column_start_num & i).Valuebuffer_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 rRow = ActiveCell.Row With ActiveSheet.Pictures.Insert(pic_urls) .Top = Selection.Top .Left = Selection.Left .ShapeRange.LockAspectRatio = msoFalse .ShapeRange.Width = pic_width .ShapeRange.Height = pic_height End With Rows(i & ":" & i).RowHeight = Range_Height Columns(pic_column_num & ":" & pic_column_num).ColumnWidth = Range_widthEnd IfNext iEnd Sub
摘自 cyuyan112233的专栏
学会宽容，要有一颗宽容的爱心！
