萬盛學電腦網

 萬盛學電腦網 >> Excel教程 >> excel綜合 >> Excel VBA如何根據姓名自動插入照片

Excel VBA如何根據姓名自動插入照片

   一、前提條件

  在Excel的單元格中,已輸入人物的姓名,並且,在姓名的下面,留有空的單元格待插入相應的圖片。

  如下圖一樣。比如,B1是姓名,而B3則是要根據張三這個姓名,自動將張三這個人的照片插入到B3中。其它以此類推。

Excel VBA如何根據姓名自動插入照片 三聯

  這得使用VBA來完成。

  同時,人物的照片所在的文件夾,和Excel工作薄,在相同的路徑,比如,下圖的位置。

  另外,每個員工的照片的名稱,都是按照員工的姓名來命名的,如下圖。

電腦教程

  像這樣的問題需求,是具備一定規律的,因此,能使用VBA來完成。

  二、實現方法

  打開你的Excel,然後執行菜單操作:“工具”→“宏”→“宏”;彈出如下圖對話框。

  上圖中,宏名那裡,輸入 AutoAddPic ,然後,點擊“創建”按鈕,彈出代碼輸入窗口,如下圖。

  代碼如上圖,請書寫完整,否則會發生異常。為方便大家的學習,下面將代碼寫為下文,以供參考:

  '自動插入圖片前,刪除所有圖片

  For Each Shp In ActiveSheet.Shapes

  If Shp.Type = msoPicture Then Shp.Delete

  Next

  Dim MyPcName As String

  For i = 1 To ThisWorkbook.ActiveSheet.UsedRange.Rows.Count

  If (ActiveSheet.Cells(i, 1).Value = "姓名") Then

  MyPcName = ActiveSheet.Cells(i, 2).Value & ".gif"

  'MsgBox "圖片的完整路徑是" & ThisWorkbook.Path & "員工照片" & MyPcName

  ActiveSheet.Cells(i + 2, 2).Select '選擇要插入圖片的單元格作為目標

  Dim MyFile As Object

  Set MyFile = CreateObject("Scripting.FileSystemObject")

  If MyFile.FileExists(ThisWorkbook.Path & "員工照片" & MyPcName) = False Then

  MsgBox ThisWorkbook.Path & "員工照片" & MyPcName & "圖片不存在"

  Else

  '在選定的單元格中插入圖片

  ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "員工照片" & MyPcName).Select

  End If

  End If

  Next i

  書寫完代碼以後,點擊窗口中的保存,然後關閉代碼窗口,返回Excel窗口。

  接著,執行菜單操作:“工具”→“宏”→“宏”,彈出如下圖。

  選中上面所創建的宏名 AutoAddPic ,然後,點擊“執行”按鈕,這樣,Excel就會根據每個姓名找到所對應的照片,將照片插入到每一個人所對應的相應的單元格。

  三、知識擴展

  ThisWorkbook.ActiveSheet.UsedRange.Rows.Count 該行代碼的含義是,獲取工作表中的有效數據的最大行。

  If (ActiveSheet.Cells(i, 1).Value = "姓名")  判定第一列中的各行,其內容是否為“姓名”二字,是姓名就去找圖片來插入,否則就不找。

  MyPcName = ActiveSheet.Cells(i, 2).Value & ".gif" 獲取每個人的照片名稱,如 青山.gif

  ThisWorkbook.Path & "員工照片" & MyPcName 獲取每個人的照片所在的路徑,是完整的絕對路徑,而不是相對路徑。

  ActiveSheet.Cells(i + 2, 2).Select '選擇要插入圖片的單元格作為目標,即哪個單元格要插入圖片,就選中哪個

  ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "員工照片" & MyPcName).Select '在選定的單元格中插入圖片

  If MyFile.FileExists(ThisWorkbook.Path & "員工照片" & MyPcName) = False Then 判斷員工照片是否存在

copyright © 萬盛學電腦網 all rights reserved