使用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操作表格