vbaword表格 怎样在Word中用VBA操作表格

使用VBA操作Word表格

一、生成表格

Private Sub CreateTable(mRows As Integer, mColumns) Dim mRange As Range

Set mRange = ActiveDocument.Range

mRange.SetRange Start:=ActiveDocument.Range.End, End:=ActiveDocument.Range.End

Set SelfGenTable = ActiveDocument.Tables.Add(Range:=mRange, NumRows:=mRows, NumColumns:=mColumns) End Sub

上面过程的作用是在活动文档的末尾插入一个mRows行，mColumns列的表格。 二、在读写表格中的单元格 写入单元格使用如下代码：

TableObject.Cell(Row:=curRow, Column:=curColumn).Range.InsertAfter "文本" 上面代码的做用时在curRow行，curColumn列处插入字符“文本”。

其中TableObject为表格对象，如果使用了生成表格中的例子，那么可以用SelfGenTable来替代TableObject。

三、调整单元格对齐方式 水平对齐设置

Selection.ParagraphFormat.Alignment=水平对齐常数（具体的常数可以查看帮助文件的说明） 如何选择单元格？ 选定特定单元格

TableObject.Cell(Row:=1,Column:=1).Select’选定单元格1,1 选定行

TableObject.Rows(i).Select’选定第i行 选定列

TableObject.Columns(i).Select’选定第i列 选定整个表格 TableObject.Select

首先执行表格元素选择程序，然后再使用Selection.ParagraphFormat.Alignment设置对齐方式。

垂直对齐方式

Selection.Cells.VerticalAlignment=垂直对齐常数

也是首先选择表格元素，可以使单个单元格，单个行、单个列或者整个表格。似乎也可以同时选择多个单元格、多个行、多个列，有兴趣的朋友可以自行寻找答案。 四、设置表格边线类型

下面的代码对整个表格的所有边线设置成细实线： SelfGenTable.Select With Selection

.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle .Borders(wdBorderLeft).LineStyle = wdLineStyleSingle .Borders(wdBorderRight).LineStyle = wdLineStyleSingle .Borders(wdBorderTop).LineStyle = wdLineStyleSingle

.Borders(wdBorderHorizontal).LineStyle = wdLineStyleSingle

Borders(wdBorderVertical).LineStyle = wdLineStyleSingle End With

同样是对Selection进行设置，所以可以依照上面的方法对特定的单元格、行或者列的边线样式进行分别设置，这里就不再列举了。 五、调整表格尺寸

下面的代码对一个六列的表格设置宽度，宽度采用百分比宽度，从左至右的宽度百分比依次为：30，10，10，30，10，10： Dim WidthP(0 To 2) As Integer Dim j As Integer dim i as Integer WidthP(0) = 30 WidthP(1) = 10 WidthP(2) = 10 j = 0

For i = 0 To SelfGenTable.Columns.Count - 1 If j > 2 Then j = 0 End If

SelfGenTable.Columns(i + 1).PreferredWidthType = wdPreferredWidthPercent SelfGenTable.Columns(i + 1).PreferredWidth = WidthP(j) j = j + 1 Next

上面的代码通过Columns的PreferredWidthType属性设置表格列宽的形式，这里选择的是百分比列宽，可以根据自己的实际情况选择其他列宽形式，然后再设置相应的数值。 表格的行高请读者以此类推（实际上我还没设置过行高，都用自动生成的就够了） ===============================================

编写操作表格的程序时需要注意，Word表格的行列起始值为1，而不是0。 ===============================================

下面是一个拆分字符串的代码，当插入表格的文本过长时，可以设定一个长度，超过这个长度就进行回车，这样保证在设定的单元格宽度内能够写下长文本。单元格的高度会自动调整以使文本能完整的显示，这也就是我为什么没有通过代码设置单元格高度的原因。 Private Function FoldText(mLen As Integer, mStr As String) As String '折叠文字函数，mLen为折叠前的文字长度，mStr为文字的内容 Dim i As Integer

Dim tmpStr(0 To 1) As String '临时字符串 If Len(mStr) > mLen Then

Do While Len(mStr) > mLen tmpStr(0) = Left(mStr, mLen)

mStr = Right(mStr, Len(mStr) - mLen)

tmpStr(1) = tmpStr(1) + tmpStr(0) + vbCrLf Loop

tmpStr(1) = tmpStr(1) + mStr Else

tmpStr(1) = mStr

使用VBA在查询WORD中表格的内容

'仅 供 参 考

'此段代码没有对数据进行校验

Sub SearchCell()

Dim inp As String

Dim r As Row, c As Cell

Dim CELL_ENDING As String

CELL_ENDING= vbCr & Chr(7) 'word表格单元格文本结束符

inp = InputBox("输 入 关 键 字：")

inp = inp & CELL_ENDING

For Each r In ThisDocument.Tables(1).Rows '这里只查找文档中第1个表格

For Each c In r.Cells

If inp = c.Range.Text Then '这里也是完全相同，也可用instr'InStr(1, c.Range.Text, inp, vbTextCompare) = 1

MsgBox Replace(r.Range.Text, CELL_ENDING, vbTab)

Exit Sub

End If

Next

Next

End Sub

非常感谢！

请问word表格单元格文本结束符不就是回车符vbCr吗？为什么还要Chr(7)？

word vba 判断表格

'一、表格标题一般应该是题注，判断题注内容
Selection.Paragraphs(1).Style="题注"
InStr(1,Selection.Paragraphs(1).Range.Text,"表")<>0'这里方法很多，可以通过域判断，也可以根据其他规则判断
'二、获取题注的结尾
styleEnd=Selection.Paragraphs(1).Range.End
'三、判断表注后面是否为表格
'参考2#
ActiveDocument.Range(styleEnd,styleEnd+1).Information(wdWithInTable)
'四、请尽量少使用Selection
'Selection使用得越少，代码效率越高
VBA将一个word表格中的内容复制到另外一个word的表格中
'打开后焦点发生了转移，activedocument已经指向刚打开的文件了
'改为
Sub Macro1()
  Dim myDoc
  'On Error Resume Next
  With ActiveDocument.Tables(1).Cell(Row:=1, Column:=3).Range
  Set myDoc = Word.Application.Documents.Open("E:\1.docx")
  .Delete
  .InsertAfter Text:=myDoc.Tables(2).Cell(Row:=1, Column:=2)
  End With
End Sub
'（
InsertAfter Text:=myDoc.Tables(2).Cell(Row:=1, Column:=2)这行代码中，你确定表2存在吗？我测试时只建一个表，所以改为Tables(1).
 
） 
 
'也可以这样控制焦点
Sub Macro1()
  Dim myDoc
  'On Error Resume Next
  Set myDoc = Word.Application.Documents.Open("E:\1.docx", , , , , , , , , , , vbHide)
   With ActiveDocument.Tables(1).Cell(Row:=1, Column:=3).Range
  .Delete
  .InsertAfter Text:=myDoc.Tables(2).Cell(Row:=1, Column:=2)
  End With
End Sub 
'至于为什么多出一个换行符我还没想明白
vba如何把word表格内容填到excel里
如果说填写，这个比较复杂，而且很难实现，因为word的VBA都是跟跟键盘操作，和界面操作有关的。
所以，如果可能，可以考虑用VBA来复制表格，然后粘贴到EXCEL中，对于比较简单的表格，内容是可以完全匹配的。
首先，你要知道如何用键盘来选择整个表格，然后复制，把这些操作录制下来，然后复制代码。。
如果你是要从EXCEL 的VBA 入手，那么你需要在VBA引用中添加WORD Libary 11.0 如果是从WORD的VBA入手，那么就要添加EXCEL LIBARY 11.0 (OFFICE 2007 是 12.0)
然后就是需要知道EXCEL中粘贴的代码，如果我记得不错的话，是：cells(1,1).paste
这个，你也可以通过录制来得到。
如果你需要知道具体的操作方案，你当然也应该吧分数提高。。。
怎么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 < Dic.count
        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表格单元格中的字符
假设 Word 文档中有这样一个表格
Word VBA 参考代码：
PublicSubReadTableData()
MsgBoxActiveDocument.Tables(1).Cell(2,1).Range.Text
EndSub
运行效果：
转载请注明出处51数据库 » vbaword表格 怎样在Word中用VBA操作表格