VBS脚本插入excel图片

提示：扫一扫查出行
【扫一扫了解最新限行尾号】
复制提示

--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()intRow = '''''''''''''''''''''''如果不想从第二行开始插入，可以修改参数intRowDo Until xlsheet.Cells(intRow,).Value = "" bottle_no=xlsheet.Cells(intRow,).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+).Left-xlsheet.Cells(intRow,no).Left-
MyPic.ShapeRange.Height=xlsheet.Cells(intRow+,no).Top-xlsheet.Cells(intRow,no).Top- MyPic.ShapeRange.Left=xlsheet.Cells(intRow,no).Left+((xlsheet.Cells(intRow,no+).Left-xlsheet.Cells(intRow,no).Left-MyPic.ShapeRange.Width)/)
MyPic.ShapeRange.Top=xlsheet.Cells(intRow,no).Top+ End If intRow = intRow + Loopxlbook.Save()
xlbook.Close()
xlapp.QuitWscript.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()intRow = '''''''''''''''''''''''如果不想从第二行开始插入，可以修改参数intRowDo Until xlsheet.Cells(intRow,).Value = "" bottle_no=xlsheet.Cells(intRow,).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 MyPic.ShapeRange.Height=xlsheet.Cells(intRow,no+).Left-xlsheet.Cells(intRow,no).Left-
MyPic.ShapeRange.Width=xlsheet.Cells(intRow+,no).Top-xlsheet.Cells(intRow,no).Top- MyPic.ShapeRange.Left=xlsheet.Cells(intRow,no).Left+((xlsheet.Cells(intRow,no+).Left-xlsheet.Cells(intRow,no).Left-MyPic.ShapeRange.Width)/)
MyPic.ShapeRange.Top=xlsheet.Cells(intRow,no).Top-((MyPic.ShapeRange.Height-xlsheet.Cells(intRow+,no).Top+xlsheet.Cells(intRow,no).Top)/) End If intRow = intRow + Loopxlbook.Save()
xlbook.Close()
xlapp.QuitWscript.StdOut.WriteLine ""
Wscript.StdOut.WriteLine ""
Wscript.StdOut.WriteLine "Pictures Inserting finished, press any key to exit !!!"
Wscript.StdIn.ReadLine