--VBS脚本插入excel图片
-------------------------2013/11/23
根据第一列的值，需找对应的图片，然后插入的指定的列中，图片根据列的长宽信息决定图片大小。
代码1图片正常状态，不旋转
Dim fso
Wscript.StdOut.WriteLine "*********************************************** "
Wscript.StdOut.WriteLine "* AUTO INSERT WIN BOTTLE PICTURE * "
Wscript.StdOut.WriteLine "* FOR VICKY * "
Wscript.StdOut.WriteLine "* version 1.0 2013/11/23 * "
Wscript.StdOut.WriteLine "*********************************************** "
Wscript.StdOut.WriteLine ""
Wscript.StdOut.WriteLine ""
Wscript.StdOut.WriteLine "Please Input which Colunm that you want to insert the pictures ? "
excelname=inputbox("Please Input the dirction and file name of the excel you want to process:")
no=cdbl(inputbox("Please Input which Colunm that you want to insert the pictures:"))
Set fso=CreateObject("Scripting.FileSystemObject")
Set xlapp = CreateObject("Excel.Application")
Set xlbook = Nothing
Set xlsheet = Nothing
Set xlbook = xlapp.Workbooks.Open(excelname)
Set xlsheet = xlbook.Worksheets(1)
intRow = 2 '''''''''''''''''''''''如果不想从第二行开始插入，可以修改参数intRow
Do Until xlsheet.Cells(intRow,1).Value = ""
bottle_no=xlsheet.Cells(intRow,1).Value
xlapp.Visible = False
xlsheet.Cells(intRow,no).Select
Tpic = "d:"&bottle_no&".jpg" '''''''''''''''''''在这里修改图片的文件夹路径
If fso.fileExists(Tpic) Then
set MyPic = xlsheet.Pictures.Insert(Tpic)
MyPic.ShapeRange.Width=xlsheet.Cells(intRow,no+1).Left-xlsheet.Cells(intRow,no).Left-4
MyPic.ShapeRange.Height=xlsheet.Cells(intRow+1,no).Top-xlsheet.Cells(intRow,no).Top-4
MyPic.ShapeRange.Left=xlsheet.Cells(intRow,no).Left+((xlsheet.Cells(intRow,no+1).Left-xlsheet.Cells(intRow,no).Left-MyPic.ShapeRange.Width)/2)
MyPic.ShapeRange.Top=xlsheet.Cells(intRow,no).Top+2
End If
intRow = intRow + 1
Loop
xlbook.Save()
xlbook.Close()
xlapp.Quit
Wscript.StdOut.WriteLine ""
Wscript.StdOut.WriteLine ""
Wscript.StdOut.WriteLine "Pictures Inserting finished, press any key to exit !!!"
Wscript.StdIn.ReadLine
设置图片旋转为横向：
Dim fso
Wscript.StdOut.WriteLine "*********************************************** "
Wscript.StdOut.WriteLine "* AUTO INSERT WIN BOTTLE PICTURE * "
Wscript.StdOut.WriteLine "* FOR VICKY * "
Wscript.StdOut.WriteLine "* version 1.0 2013/11/23 * "
Wscript.StdOut.WriteLine "*********************************************** "
Wscript.StdOut.WriteLine ""
Wscript.StdOut.WriteLine ""
Wscript.StdOut.WriteLine "Please Input which Colunm that you want to insert the pictures ? "
excelname=inputbox("Please Input the dirction and file name of the excel you want to process:")
no=cdbl(inputbox("Please Input which Colunm that you want to insert the pictures:"))
Set fso=CreateObject("Scripting.FileSystemObject")
Set xlapp = CreateObject("Excel.Application")
Set xlbook = Nothing
Set xlsheet = Nothing
Set xlbook = xlapp.Workbooks.Open(excelname)
Set xlsheet = xlbook.Worksheets(1)
intRow = 2 '''''''''''''''''''''''如果不想从第二行开始插入，可以修改参数intRow
Do Until xlsheet.Cells(intRow,1).Value = ""
bottle_no=xlsheet.Cells(intRow,1).Value
xlapp.Visible = False
xlsheet.Cells(intRow,no).Select
Tpic = "d:"&bottle_no&".jpg" '''''''''''''''''''在这里修改图片的文件夹路径
If fso.fileExists(Tpic) Then
set MyPic = xlsheet.Pictures.Insert(Tpic)
MyPic.ShapeRange.IncrementRotation 270
MyPic.ShapeRange.Height=xlsheet.Cells(intRow,no+1).Left-xlsheet.Cells(intRow,no).Left-4
MyPic.ShapeRange.Width=xlsheet.Cells(intRow+1,no).Top-xlsheet.Cells(intRow,no).Top-4
MyPic.ShapeRange.Left=xlsheet.Cells(intRow,no).Left+((xlsheet.Cells(intRow,no+1).Left-xlsheet.Cells(intRow,no).Left-MyPic.ShapeRange.Width)/2)
MyPic.ShapeRange.Top=xlsheet.Cells(intRow,no).Top-((MyPic.ShapeRange.Height-xlsheet.Cells(intRow+1,no).Top+xlsheet.Cells(intRow,no).Top)/2)
End If
intRow = intRow + 1
Loop
xlbook.Save()
xlbook.Close()
xlapp.Quit
Wscript.StdOut.WriteLine ""
Wscript.StdOut.WriteLine ""
Wscript.StdOut.WriteLine "Pictures Inserting finished, press any key to exit !!!"
Wscript.StdIn.ReadLine
相关信息：
console中输入数字：no = cdbl(Wscript.StdIn.ReadLine)
选择excel单元格另一种方法：xlsheet.Range("E4").Select