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 =                '''''''''''''''''''''''如果不想从第二行开始插入，可以修改参数intRow

Do 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 +  

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()

intRow =              '''''''''''''''''''''''如果不想从第二行开始插入，可以修改参数intRow

Do 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 +  

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