首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

能例举一些针对WORD的VBA代码吗?解决思路

2012-01-11 
能例举一些针对WORD的VBA代码吗?能例举一些针对WORD的VBA代码吗?另外这些都可以用在VB程序中吗?[解决办法]

能例举一些针对WORD的VBA代码吗?
能例举一些针对WORD的VBA代码吗?
另外这些都可以用在VB程序中吗?

[解决办法]

VBScript code
'将当前文档中的‘文本框拼成的表格’转换成‘实际表格’Sub TextFrame2Table()Dim i As IntegerDim j As IntegerDim k As IntegerDim r As IntegerDim c As IntegerDim n As IntegerDim nb As IntegerDim s As SingleDim x(10000) As SingleDim y(10000) As SingleDim m(10000) As IntegerDim tblNew As TableDim t As StringDim sh As Shape    On Error Resume Next    For Each sh In Word.ActiveDocument.Shapes        If sh.Type = msoGroup Then sh.Ungroup    Next    n = Word.ActiveDocument.Shapes.Count    nb = 0    For i = 1 To n        If Word.ActiveDocument.Shapes(i).Type = msoAutoShape Or Word.ActiveDocument.Shapes(i).Type = msoTextBox Then            nb = nb + 1            If nb > 10000 Then MsgBox ("文本框太多>10000,忽略多出的文本框"): Exit For            m(nb) = i            x(nb) = Word.ActiveDocument.Shapes(i).Left            y(nb) = Word.ActiveDocument.Shapes(i).Top        End If    Next    If nb<2 Then MsgBox ("文本框太少<2,无法转换"): Exit Sub    For i = 2 To nb        For j = 1 To i            If (Abs(y(j) - y(i)) >= 1 And y(j) > y(i)) Or (Abs(y(j) - y(i)) < 1 And (Abs(x(j) - x(i)) >= 1 And x(j) > x(i))) Then                s = x(i): x(i) = x(j): x(j) = s                s = y(i): y(i) = y(j): y(j) = s                k = m(i): m(i) = m(j): m(j) = k            End If        Next    Next    c = Val(InputBox("请输入要转换成多少列的表(1~" + CStr(nb) + "):"))    If c <= 0 Or c > nb Then MsgBox ("输入的列数无效"): Exit Sub    r = Int((nb - 1) / c) + 1    Set tblNew = ActiveDocument.Tables.Add(ActiveDocument.Range(0, 0), r, c)    tblNew.AllowAutoFit = True    tblNew.AutoFitBehavior wdAutoFitContent    For i = 1 To nb        t = ""        t = Word.ActiveDocument.Shapes(m(i)).TextFrame.TextRange.Text        If t <> "" Then            Do                If t = "" Then Exit Do                k = Asc(Right(t, 1))                If k = 13 Or k = 10 Or k = 32 Then                    t = Left(t, Len(t) - 1)                Else                    Exit Do                End If            Loop            If t <> "" Then                tblNew.Range.Cells(i).Range.InsertAfter t            End If        End If    Next    tblNew.AllowAutoFit = False    MsgBox ("转换后的表格已放在文档开始")End Sub 

热点排行