---
# System prepended metadata

title: Excel Application 插入圖片
tags: [UFT, Excel]

---

# Excel Application 插入圖片
:::info
:information_source: Info
UFT 14.52
VB Script
:::


以目前現有的Excel 檔案開啟後插入圖片
使用Activate 定位插入位置


``` = VB
Sub  AddImgToExcel
	
	ExcelFileName = Environment("ResultPath")
	PicPath = Environment("ResultDir") & "\"
	
	Set objExcel = CreatObject("Excel.Application")
	objExcel.Visible = True                     '-- 將Excel 改為可見的
	objExcel.DisplayAlerts = False        '--警告對話框關閉顯示
	
	Set  objWbook = objExcel.Workbooks.Open(ExcelFileName)
	objWbook.Worksheets.Item("Result").Activate
	
	Set objWSheet = objWbook.Worksheet.Item("Result")
	
	'取有值Row總數
	row = objWSheet.Rows.Count
	For j =1 To row
		If objWSheet.Renge("A" & Cstr(j)).Value = "" Then
			row = j -1
			Exit For
		End If
	
	Next
	
	'插入圖片
	For  i = 2 To row Step 1
		
		If  i = 2 Then
			j = row +3
		Else
			j = j + 37  '--每張圖片間隔37行
		End If
		
		SelectCell = "A" & Cstr(j)  '--插入圖片的位置
		FileCell = "H" & i  '--取圖片檔名的位置
		PicFileName = objWSheet.Renge(FileCell ).Value
		objWSheet.Renge(SelectCell ).Active
		objExcel .ActiveCell.Worksheet.Pictures.Insert(PicPath & PicFileName)

	Next
	
	objWbook.Save
	objExcel .Quit
	objExcel.DisplayAlerts = True
	
	Set objExcel  =  Nothing
	Set objWbook =  Nothing
	Set objWSheet =  Nothing
End Sub
```

###### tags: `UFT`, `Excel`