word excel vba 实例 excel vba 实例
VBA Word Excel 数据交互
我是使用OFFICE 2003来做的，不知道你那好使不好使Private Sub CommandButton2_Click()"防止重复打开同一Word文档导致错误If Not WordDocIsOpen(＂F：\总工月报表.doc＂) Then"创建Word对象Set objWordApp = CreateObject(＂Word.Application＂)objWordApp.Visible = True"打开指定文档Set objDocument = objWordApp.Documents.Open(＂F：\总工月报表.doc＂)"获取当前Excel的SHEET1的单元格C2数据strName = ThisWorkbook.Sheets(1).Cells(2, 3).Value"将取得得值设定到Word表格的1行2列中objDocument.Tables(1).Cell(1, 2).Range.Text = strNameEnd IfEnd Sub"判断Word文档是否被重复打开Function WordDocIsOpen(ByVal strDocName As String) As BooleanDim objWordApp As ObjectDim objWordDoc As ObjectWordDocIsOpen = FalseSet objWordApp = NothingOn Error Resume NextstrDocName = UCase(strDocName)"判断是否有Word程序被打开Set objWordApp = GetObject(, ＂Word.Application＂)If Not objWordApp Is Nothing Then"判断指定Word文件是否被打开For Each objWordDoc In objWordApp.DocumentsIf UCase(objWordDoc.FullName) = strDocName ThenWordDocIsOpen = TrueExit ForEnd IfNextEnd IfSet objWordDoc = NothingSet objWordApp = NothingEnd Function
如何在excel vba中调用word vba过程sub test
一、打开word文件代码：Setwo=CreateObject(＂Word.Application＂)wo.Documents.OpenThisWorkbook.Path&＂\流程.doc＂wo.Visible=True二、打开ppt文件代码：方法1:Setwo=CreateObject(＂Powerpoint.Application＂)wo.Visible=Truewo.Presentations.OpenThisWorkbook.Path&filename方法2:Subdd()Dimfilepath$,filename$filepath=Chr(34)&ThisWorkbook.Path&filename&Chr(34)Shell＂POWERPNT.EXE＂&filepathEndSub附：双击打开PPS文件，在演示完后退出PPS时并没有PowerPoint主窗口保留，但在Excel中使用VBA打开的PPS文件，在演示完PPS退出后，PowerPoint主窗口仍然打开。
这里使用一个循环判断演示窗口是否存在，加上错误捕捉程序来处理上面这个问题。
PrivateSubCommandButton1_Click()DimwoAsObjectDimappAsObject"创建PowerPoint应用实例Setapp=CreateObject(＂Powerpoint.Application＂)"使PowerPoint可见app.Visible=True"打开PPS文件Setwo=app.Presentations.Open(ThisWorkbook.Path&＂\a.pps＂)"当PPS演示结束时，wo对象的SlideShowWindow不存在，捕捉到错误OnErrorGoToerrHandle"PPS演示时全屏
VBA excel调用word内容
在有word文件的文件夹中新建一个excel工作簿，打开工作簿，按Alt+F11，把下面的代码复制进去，按F5执行。
代码会复制work文件的前300个字符到excel中。
Sub test() Dim i%, myName$, myPath$, AppWord As Object Set AppWord = CreateObject(＂Word.Application＂) myPath = ThisWorkbook.Path & ＂\＂ myName = Dir(myPath & ＂*.doc*＂) With ActiveSheet .Columns(＂A:B＂).ClearContents Do While myName ＂＂ AppWord.Documents.Open Filename:=myPath & myName i = i + 1 .Cells(i, 1) = myName .Cells(i, 2) = AppWord.ActiveDocument.Range(Start:=0, End:=300).Text AppWord.ActiveDocument.Close False myName = Dir Loop End With AppWord.Quit Set AppWord = Nothing MsgBox ＂已完成。
＂End Sub...
怎么vba实现word表格批量转为excel
注：vba偶并不太熟（偶一般是用c#和delphi的），VBA只是稍有了解，以下代码大部分是偶google到的内容拼出来的。
。
。
。
。
如下，使用时先更改test下的docpath和xlspath路径设定，docpath即你的word的目录，此目录包括子目录下的所有doc将被读取，xlspath即输出目录，需要存在 在VBA窗口中，先在视图下显示立即窗口以观察进度，程序最后的输出类似这样 正在读取[1]:->D:\1\Resume.doc 正在生成：->d:\2\Resume 正在读取[2]:->D:\1\简历（简）.doc 正在生成：->d:\2\简历（简） 正在读取[3]:->D:\1\计数器说明.doc 正在生成：->d:\2\计数器说明 共耗时0分41秒 Option Explicit Dim docpath As String, xlspath As String"ResultFlag=0 获取路径"ResultFlag=1 获取文件名"ResultFlag=2 获取扩展名 Public Function SplitPath(FullPath As String, ResultFlag As Integer) As String Dim SplitPos As Integer, DotPos As Integer SplitPos = InStrRev(FullPath, ＂\＂) DotPos = InStrRev(FullPath, ＂.＂) Select Case ResultFlag Case 0 SplitPath = Left(FullPath, SplitPos - 1) Case 1 If DotPos = 0 Then DotPos = Len(FullPath) + 1 SplitPath = Mid(FullPath, SplitPos + 1, DotPos - SplitPos - 1) Case 2 If DotPos = 0 Then DotPos = Len(FullPath) SplitPath = Mid(FullPath, DotPos + 1) Case Else Err.Raise vbObjectError + 1, ＂SplitPath Function＂, ＂Invalid Parameter!＂ End Select End Function Public Function FileFolderExists(ByVal strFullPath As String) As Boolean On Error GoTo EarlyExit If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True EarlyExit: On Error GoTo 0 End Function Sub Test（) "使用双字典，旨在提高速度 Dim MyName, Dic, Did, I, T, F, TT, MyFileName, Doc, Ke Dim count As Integer count = 0 T = Time docpath = ＂D:\1\＂ xlspath = ＂d:\2\＂ Set Dic = CreateObject(＂Scripting.Dictionary＂) "创建一个字典对象 Set Did = CreateObject(＂Scripting.Dictionary＂) Dic.Add (docpath), ＂＂ I = 0 Do While I Ke = Dic.keys "开始遍历字典 MyName = Dir(Ke(I), vbDirectory） "查找目录 Do While MyName ＂＂ If MyName ＂.＂ And MyName ＂..＂ Then If (GetAttr(Ke(I) & MyName) And vbDirectory) = vbDirectory Then "如果是次级目录 Dic.Add (Ke(I) & MyName & ＂\＂）， ＂＂ "就往字典中添加这个次级目录名作为一个条目 End If End If MyName = Dir "继续遍历寻找 Loop I = I + 1 Loop "Did.Add （＂文件清单＂）， ＂＂ "以查找D盘下所有EXCEL文件为例 For Each Ke In Dic.keys MyFileName = Dir(Ke & ＂*.doc＂) Do While MyFileName ＂＂ Doc = Ke & MyFileName Did.Add (Doc), ＂＂ count = count + 1 Debug.Print ＂正在读取[＂ & count & ＂]:->＂ & Doc doc2xls (Doc) MyFileName = Dir Loop Next " For Each Sh In ThisWorkbook.Worksheets " If Sh.Name = ＂XLS文件清单＂ Then " Sheets(＂XLS文件清单＂).Cells.Delete " F = True " Exit For " Else " F = False " End If " Next "If Not F Then " Sheets.Add.Name = ＂XLS文件清单＂ "End If "Sheets(＂XLS文件清单＂).[A1].Resize(Did.Count, 1) = WorksheetFunction.Transpose(Did.keys) TT = Time - T Debug.Print ＂共耗时＂ & Minute(TT) & ＂分＂ & Second(TT) & ＂秒＂ End Sub Sub doc2xls(filename As String) Dim xlApp As Object, xlSheet As Object, outfile As String, c As Object Set xlApp = CreateObject(＂Excel.Application＂) Set xlSheet = xlApp.Workbooks.Add.Sheets(1) Dim Wapp As Object, Doc As Object, GetDocText As Object "Word Application 对象、Document 对象 Set Wapp = CreateObject(＂Word.Application＂) "创建Word Application 对象 Set Doc = Wapp.Documents.Open(filename, ReadOnly:=True) "打开文档，返回一个文档对象"xlSheet.Range(＂A1＂) = Doc.Content.Text Doc.Application.Selection.WholeStory """"全选 Doc.Application.Selection.Copy """"""""""复制 xlSheet.Range(＂A1＂).Select xlSheet.Paste outfile = xlspath + Replace(SplitPath(filename, 1), ＂.doc＂, ＂.xls＂) Debug.Print ＂正在生成：->＂ & outfile xlSheet.Parent.SaveAs outfile xlApp.Quit Set xlSheet = Nothing Set xlApp = Nothing Wapp.Quit Set Doc = Nothing Set Wapp = Nothing End Sub
vba,word和excel相互调用
总是要有一个打开的时机的，总要有一段打开的代码，不然怎么凭空打开，怎么获取打开的文件名. 如果你想在你的宏运行前打开，你可以把调用与打开的代码放在宏运行的前面. 如：以excel打开word为例，你可以在Workbook_Open下放置你调用和打开word 的代码： Private Sub Workbook_Open() dim aaa as ...application End Sub 方法你应该比较熟悉了，就是在vbaproject下双击ThisWorkbook，然后在上边的下拉列表里选对象和事件.如果在宏中用路径打开被调用的文件，那么该文件就必须放在路径指定的位置，我不想这样。
我想放在任意位置。
放在任意位置你可以用一个打开对话框呀，如下面代码：Dim fd As FileDialog Dim Wbook As Workbook Dim rowindex As Integer Set fd = Application.FileDialog(msoFileDialogFilePicker) Dim vrtSelectedItem As Variant With fd .Filters.Add ＂EXCEL 文件＂， ＂*.xls＂, 1 "过滤 If .Show = -1 Then rowindex = 1 For Each vrtSelectedItem In .SelectedItems Set Wbook = Workbooks.Open(vrtSelectedItem)
java word转换excel例子
首先alt+f11，工具引用，勾选microsoft excel 11.0 object library，然后插入模块 Sub op()Dim app As New Excel.ApplicationDim wb As Excel.WorkbookSet wb = app.Workbooks.Open(＂d:/tt.xls＂)MsgBox wb.Sheets(＂sheet1＂).Range(＂c5＂)app.QuitEnd Sub子易空间站 - Excel培训专家
用VBA直接在WORD中能正常运行的方法或属性相关常量设置,在...
前期绑定的好处在于，由该绑定类库所引申出来的常数、对象、属性和方法，都可以被直接应用。
对于wdPropertyLines和wdAlignParagraphCenter这些常数，如果在前期绑定时，那么这些常数就和其对应的值一一对应了，因为在类库的内部，已经对这些常数进行了定义和赋值。
然而通过后期绑定Set wordAppl = CreateObject(＂Word.Application＂)这种方法引用的word对象，仅仅wordAppl这个实例才拥有各种属性和方法。
然而Microsoft Word 11.0 Object Library这个类库所包含的word.application仅仅只是其中的一个对象，wdPropertyLines和wdAlignParagraphCenter在这个类库中，但并不一定在word.application这个对象中。
而且，你的excel因为没有引用Microsoft Word 11.0 Object Library，所以计算机就不能识别，于是产生错误。
解决办法，你打开一个Word文档，然后在Word中通过 ：Sub xx()Msgbox wdAlignParagraphCenter "弹出值为：1MsgBox wdPropertyLines "弹出值为：23End Sub然后，你在Excel中，使用如下代码：.ParagraphFormat.Alignment = 1 "1 = wdAlignParagraphCenterwdLines =.BuiltInDocumentProperties(23) "23 = wdPropertyLines你可以一试，希望能够正确，并对你有帮助！！
excel vba 读取 word 指定字符
Sub 按钮1()Dim myPath As StringSet Wdapp = CreateObject(＂Word.Application＂)Wdapp.Visible = TrueApplication.ScreenUpdating = False "关闭屏幕刷新" On Error Resume Next "捕捉错误myPath = ThisWorkbook.Path & ＂\多房地产预评估函.doc＂ "定义word文件路径，自己修改Set wdDoc = Wdapp.Documents.Open(myPath) "打开wordwdDoc.Activatesr = wdDoc.Content "将word的文档内容赋予变量srMsgBox Mid(sr, InStr(sr， ＂籍贯＂) + 3, 2)wdDoc.Close "关闭wordWdapp.QuitSet Wdapp = NothingSet wdDoc = NothingApplication.ScreenUpdating = True "开启屏幕刷新End Sub
-