【原】Excel VBA 7.79如何快速的将其他文件中的图片复制过来？我们要高效的做事

Excel和VBA 2021-05-09

展开全文

如何快速的将其他文件中的图片复制过来？我们要高效的做事

点击上方“Excel和VBA”，选择“置顶公众号”

致力于原创分享Excel的相关知识，源码，源文件打包提供

一起学习，一起进步~~

今天我们来继续分享下工作表中图片的一些操作，也算是工作表这一系列的最后一个章节了，之后我们将会进入单元格的相关操作中，进入我们今天的正题，今天我们要实现的是从其他的Excel文件中将图片直接插入当前工作表中，在之前我们学习了批量插入和批量保存，不过如果在保存之后，在插入也是可以的，但是我们今天更加方便一点，如果这个图片我们只是在工作的时候有需要，那就没有保存的价值了，直接在做报表的时候，将图片复制过来不就好了。当然我们不可能手工复制，我们学习VBA的目的就是要高效办公。

场景说明

这是我们之前76节那篇分享的excel

我们还是那哪一节的文件来做案例，我们现在有另外一张工作表，我们现在希望将7-76哪一节的图片复制到我们的新的工作表中，并不是全部复制，仅仅是部分复制，来看看VBA如何实现

代码区

Sub 复制图片()Dim rng As Range, rng1 As Range, cll As RangeDim rngPN As Range, rngP As Range, rngPN2 As RangeDim shp As Shape, sht As Worksheet, sht1 As WorksheetSet sht = ActiveSheetSet rng = Application.InputBox("请选择应插入图片名称的单元格区域", Type:=8)Set rng1 = rng.Offset(0, 1)With Application.FileDialog(msoFileDialogFilePicker) .Title = "请选择图片所在的文件" If .Show = -1 Then Filename = .SelectedItems(1) End IfEnd WithWorkbooks.Open FilenameSet sht1 = ActiveSheetApplication.ScreenUpdating = Falsesht.Activaterng.Parent.SelectFor Each cll In rng strPN = cll.Text If Len(strPN) Then Set rngPN = sht1.Cells.Find(cll.Value, , , xlWhole) If Not rngPN Is Nothing Then Set rngPN2 = cll.Offset(0, 1) Set rngP = rngPN.Offset(0, 1) rngPN2.RowHeight = rngP.RowHeight rngPN2.ColumnWidth = rngP.ColumnWidth rngPN.Offset(0, 1).Copy rngPN2 End If End IfNext cllApplication.ScreenUpdating = TrueEnd Sub

有一些代码还是非常的熟悉的，我们先来看看效果

从上面的图中我们可以看到，不管图片名称的顺序是否相同，他都可以根据名称找到对应的图片，并且自动调整单元格的大小，以一个更加合适的状态展示效果，非常的完美

代码解析

现在来看看我们的代码

其实并不算是很难，都是将之前的一些基础知识点汇总在一起来

Set rng = Application.InputBox("请选择应插入图片名称的单元格区域", Type:=8)Set rng1 = rng.Offset(0, 1)With Application.FileDialog(msoFileDialogFilePicker) .Title = "请选择图片所在的文件" If .Show = -1 Then Filename = .SelectedItems(1) End IfEnd With

选择单元格，并且根据自己的需要选择所在的Excel文档的位置，完全是根据我们自己的需求自己选择的，非常的方便。