excel图片与文档结合宏

截图与表格结合 工作中需要将导出的表格与截图整合到一个excel表中进行数据整理与备份,便于查阅调取以及进行数据分析。 传统的手动制作表格费时费力在进行大量素材处理的时候是无法进行的。 思路:将素材存放在一个文档中,利用bat获取文件名,利用excel宏将表格及截图整理到一个总表中并设置好索引,添加返回链接。 Sub A() Application.DisplayAlerts = False myarray = WorksheetFunction.Transpose(Range("arr")) myarray2 = WorksheetFunction.Transpose(Range("brr")) For mycount = LBound(myarray) To UBound(myarray) Workbooks.Open Filename:=ThisWorkbook.Path & "\" & myarray(mycount) Windows(myarray(mycount)).Activate Sheets("rep_jour ").Copy before:=Windows("明细.xlsm").ActiveSheet ActiveSheet.Name = myarray2(mycount) Rows("1:34").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("A1").Select ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & myarray2(mycount) & ".jpg").Select Rows("1:1").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove ActiveSheet.Range("A1") = "=HYPERLINK(""#目录!A1"",""返回"")" Workbooks(myarray(mycount)).Close Next mycount Workbooks("明细.xlsm").Save End Sub Sub AA() Y = Year(Date) m = Month(Date) D = 22 If D = 0 Then m = Month(Date) - 1 D = Day(Date - 1) End If Application.DisplayAlerts = False Workbooks.Open Filename:=ThisWorkbook.Path & "\" & Y & "." & m & "." & D & ".xls" Windows(Y & "." & m & "." & D & ".xls").Activate Sheets("rep_jour ").Copy before:=Windows("明细.xlsm").ActiveSheet ActiveSheet.Name = Y & "." & m & "." & D Rows("1:34").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("A1").Select ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Y & "." & m & "." & D & ".jpg").Select Rows("1:1").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove ActiveSheet.Range("A1") = "=HYPERLINK(""#目录!A1"",""返回"")" Workbooks(Y & "." & m & "." & D & ".xls").Close Workbooks("明细.xlsm").Save End Sub 调整图片大小 Selection.ShapeRange.ScaleWidth 0.8737373737, msoFalse, msoScaleFromTopLeft Selection.ShapeRange.ScaleHeight 0.8737373737, msoFalse, msoScaleFromTopLeft 宏A适用于大量素材的处理 宏AA适用于个别素材的处理 Sub A()//宏名 Application.DisplayAlerts = False//关闭不出现提示信息 myarray = WorksheetFunction.Transpose(Range("arr"))//设置数组myarray为名称arr myarray2 = WorksheetFunction.Transpose(Range("brr"))//设置数组myarray2为名称brr For mycount = LBound(myarray) To UBound(myarray)//循环次数等于数组myarray的最小值到最大值 Workbooks.Open Filename:=ThisWorkbook.Path & "\" & myarray(mycount) //打开文档路径数组文件名 Windows(myarray(mycount)).Activate//激活文件窗口 Sheets("rep_jour ").Copy before:=Windows("明细.xlsm").ActiveSheet //复制表到明细的激活表之前 ActiveSheet.Name = myarray2(mycount) //激活表名为 Rows("1:34").Select //选择1:34行 Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove //插入活动表下移 Range("A1").Select //选择单元格 ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & myarray2(mycount) & ".jpg").Select //在激活表中插入图片 Rows("1:1").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove //插入一行 ActiveSheet.Range("A1") = "=HYPERLINK(""#目录!A1"",""返回"")" //A1填入返回链接公式 Workbooks(myarray(mycount)).Close //关闭文档 Next mycount //继续循环 Workbooks("明细.xlsm").Save //保存 End Sub //结束 Sub AA() Y = Year(Date) m = Month(Date) D = 22 If D = 0 Then m = Month(Date) - 1 D = Day(Date - 1) End If Application.DisplayAlerts = False Workbooks.Open Filename:=ThisWorkbook.Path & "\" & Y & "." & m & "." & D & ".xls" Windows(Y & "." & m & "." & D & ".xls").Activate Sheets("rep_jour ").Copy before:=Windows("明细.xlsm").ActiveSheet ActiveSheet.Name = Y & "." & m & "." & D Rows("1:34").Select