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

來源:互聯網
上載者:User

   一、前提條件

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

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

  這得使用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 判斷員工照片是否存在

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.