2022年VB打开Excel文件 .pdf

《2022年VB打开Excel文件 .pdf》由会员分享，可在线阅读，更多相关《2022年VB打开Excel文件 .pdf（5页珍藏版）》请在淘文阁 - 分享文档赚钱的网站上搜索。

1、VB打开 Excel 文件的较完整代码：包括检查文件是否存在、以及文件是否打开。Private Sub Open_Excel()Dim xlApp As excel.Application Dim xlBook As excel.Workbook FileName=文件的具体路径On Error Resume Next Set xlApp=GetObject(,Excel.Application)判断 Excel 是否打开 If Err.Number 0 Then Set xlApp=CreateObject(Excel.Application)创建 EXCEL 对象 xlApp.Visibl

2、e=False 设置 EXCEL 对象不可见 End If Err.Clear If Dir(App.Path&FileName)=Then 判断文件是否存在 MsgBox App.Path&FileName&未找到！,vbOKOnly,友情提示 exit Sub End If 判断文件是否打开 For Each xlBook In xlApp.Workbooks If xlBook.Name=Mid(FileName,2)Then MsgBox 文件已打开！请不要重复打开。,vbOKOnly,友情提示 xlBook.Activate xlApp.WindowState=xlMaximized

3、 exit Sub End If Next Set xlBook=xlApp.Workbooks.Open(App.Path&FileName)打开工件簿文件 xlBook.RunAutoMacros(xlAutoOpen)运行 EXCEL 启动宏 xlBook.RunAutoMacros(xlAutoClose)运行 EXCEL 关闭宏 xlApp.Visible=True End Sub 单击单元格，弹出对话框设在 Sheet1 中的 A1 选定则弹出对话框按 Alt+F11 进入 VBA 环境,进入 Sheet1 模块 录入以下就行Private Sub Worksheet_Select

4、ionChange(ByVal Target As Range)名师资料总结-精品资料欢迎下载-名师精心整理-第 1 页，共 5 页 -If Target.Row=1 And Target.Column=1 Then MsgBox Input message.,vbOKOnly+vbInformation,title End If End Sub VB 抓取文件夹里的图片悬赏分：85-解决时间：2009-2-12 22:24我想要实现VB 把一个文件夹的图片有选择的插到EXCEL 里，用 EXCEL 的宏不好使，Set Photo=ActiveSheet.Pictures.Insert(G:s

5、ecbenq16201494025674.jpg)，这样的代码也只能插入一张，我的思路是自动遍历磁盘，然后根据文件建立的时间，用循环的方法插入到 EXCEL 里，大家帮帮我啊，急用！80 分悬赏啊！Option Base 1 Dim fs Dim f Dim fd Public Type picFile FullName As String DateCreated As Date LaseModified As Date End Type Dim iCount As Integer Dim arrPics()As picFile Sub test()Dim sf As String sf=In

6、putBox(您要在哪个文件夹中查找图片？&vbCrLf&请在下面输入它的完整路径：,提示)获取用户输入的文件夹If Right(sf,1)Then sf=sf&Set fs=CreateObject(Scripting.FileSystemObject)检验用户输入的有效性On Error Resume Next Set fd=fs.GetFolder(sf)On Error GoTo 0 If fd Is Nothing Then MsgBox 输入错误 Exit Sub End If GetPictures sf,True 这个过程将该文件夹内的所有jpg,gif,bmp文件的完整路径及

7、创建日期放到 arrPics 数组中，第一个参数指定文件夹路径，第二个参数指定是否查找子目录名师资料总结-精品资料欢迎下载-名师精心整理-第 2 页，共 5 页 -Sort arrPics 对数组中的文件按创建日期排序Dim shp lLeft=Cells(1,1).Width+2 For i=1 To UBound(arrPics)依次将图片插入到工作表中，每行一个图片Set shp=ActiveSheet.Pictures.Insert(arrPics(i).FullName)Cells(i,1)=arrPics(i).FullName If shp.Height 0 Then If iC

8、ount=0 Then ReDim Preserve arrPics(1)As picFile Else ReDim Preserve arrPics(iCount+1)As picFile End If iCount=iCount+1 arrPics(iCount).FullName=f.Path 名师资料总结-精品资料欢迎下载-名师精心整理-第 3 页，共 5 页 -arrPics(iCount).DateCreated=f.DateCreated End If DoEvents Next If IncludeSubfolders Then For Each fd In fs.GetFol

9、der(sFolder).SubFolders GetPictures fd.Path,IncludeSubfolders Next End If End Sub Sub Sort(arr()As picFile)Dim tmpFile As picFile For i=LBound(arr()To UBound(arr()For j=i+1 To UBound(arr()If arr(j).DateCreated arr(i).DateCreated Then tmpFile=arr(j)arr(j)=arr(i)arr(i)=tmpFile End If Next Next End Sub

10、 单元格中，自动插入图片打开 D:tree 目录下的工作簿，在excel 工作表中同时按下ALT 和 F11 两个键，进入VBA编程，点击VBA 编程中的菜单：“插入模块”，把下面的代码粘贴到模块的空白区以后，返回到 excel 工作表，点击菜单工具宏宏，选择宏名kkk 运行代码。sub kkk()aa=ActiveWorkbook.Sheets.Count For i=1 To aa Worksheets(i).Select Worksheets(i).Range(A2).Select Sheets(i).Range(A2).RowHeight=60 ActiveSheet.Shapes.A

11、ddShape(msoShapeRectangle,0,48,72,60).Select Selection.ShapeRange.Fill.Visible=msoFalse Selection.ShapeRange.Shadow.Obscured=msoTrue Selection.ShapeRange.Shadow.Type=msoShadow18 名师资料总结-精品资料欢迎下载-名师精心整理-第 4 页，共 5 页 -Selection.ShapeRange.Fill.UserPicture d:pic&Worksheets(i).Range(A1).Value&.jpg Next i

12、end sub 每个工作表的 A1单元格应输入“王二”等姓名，而且与D：pic 目录下的图片文件对应打开 D:tree 目录下的工作簿，在excel 工作表中同时按下ALT 和 F11 两个键，进入VBA编程，点击VBA 编程中的菜单：“插入模块”，把下面的代码粘贴到模块的空白区以后，返回到 excel 工作表，点击菜单工具宏宏，选择宏名kkk 运行代码。在工作表中插入图片使用 Insert 方法，例如，下面的代码将从Web 网上相应的地址中获取图片并在当前工作表中以活动单元格为起点放置图片。Sub InsertPicture()ActiveSheet.Pictures.Insert“UploadFiles/2006-10/1025523341.jpg End Sub 同理，下面的代码将从您的计算机中的C 盘相应文件夹中获取图片并在当前工作表中以活动单元格为起点放置图片。Sub InsertPicture()ActiveSheet.Pictures.Insert _ 示例图片 Water lilies.jpg End Sub名师资料总结-精品资料欢迎下载-名师精心整理-第 5 页，共 5 页 -