让人头大的word文档

lsc

一个朋友发来的这个文档，让我在这个文档的表格中，插入几行新增的内容？俺一看表格内容，差点晕倒。。请大家邦着看看，这样的word表格，有没有办法能象excel一样，插入行。。

MzSWl6aI.rar (3.76 KB, 下载次数: 29)

2007-5-10 17:02 上传

点击文件名下载附件
让人头大的word文档

jhjdcg

呵呵，是够晕的，精黑线是用绘图工具画的，长方格是加的文本框，然后设置了组合，不知这样做是什么目的，没发现比用表格工具有好处

dsp5000

还没看呢，听2位说的就挺逗乐的。。。。。。。

dsp5000

够不容易的给拼成这样。。。

dsp5000

唉，还不如重新做个表呢。。。。[em06]

sylun

估计是选择性粘贴而成的图形对象。
刚才尝试用vba处理，勉强可以，但次序有点乱，不知何解。
Sub aaa()
'请先在文档中插入相应行、列数的表格再运行本程序
Dim i As Integer, myshape As Shape, mytext As String
With ThisDocument.Content.ShapeRange
    If .Type = msoGroup Then .Ungroup
End With
For Each myshape In ThisDocument.Shapes
If myshape.Type <> msoLine Then
    i = i + 1
    mytext = myshape.TextFrame.TextRange.Text
    If i Mod 2 = 1 Then
        ThisDocument.Tables(1).Rows(ThisDocument.Tables(1).Rows.Count - Int(i / 2) ).Cells(2).Range _
        = Trim(Replace(Left(mytext, Len(mytext) - 1), " ", ""))
    Else
        ThisDocument.Tables(1).Rows(ThisDocument.Tables(1).Rows.Count - Int(i / 2)+1).Cells(1).Range _
        = Trim(Replace(Left(mytext, Len(mytext) - 1), " ", ""))
    End If
End If
Next
End Sub

[此贴子已经被作者于2007-5-10 19:33:32编辑过]

守柔

QUOTE:

这种形式的“表格”，我在论坛，总共见到三次。

要不是程序自动生成的，必是“牛”人所为。

如果“牛”人能做到如此图形精确组合，必是高手，所以还是不要猜是哪位高手所为，我以为，程序导出或者生成的可能性更高一些。

我使用“擦边球”的方式进行了一次尝次，这也是我以前一直想的方法，如果是多页，可以分页进行或者其他方式，原理相通。

Option Explicit
Option Compare Text
Sub Test()
    Dim oShape As Shape, N As Single, myString As String
    Dim newDoc As Document, myRange As Range
    On Error Resume Next '忽略错误
    '取消图形组合
    ActiveDocument.Content.ShapeRange.Ungroup
    For Each oShape In ActiveDocument.Shapes '遍历图形
        If oShape.TextFrame.HasText = True Then '如果具有文字(也可另行判断)
            N = oShape.Left + oShape.Top * 100 '此处作一埋伏,即以顶部距离为主要"列"判断依据
            myString = myString & N & "|" & VBA.Replace(oShape.TextFrame.TextRange.Text, " ", "")
        End If
    Next
    myString = VBA.Mid(myString, 1, Len(myString) - 1) '去除最后一个段落标记(注意文本框返回时已具有段落标记)
    Set newDoc = Documents.Add '新建一个空白文档
    Set myRange = newDoc.Content
    myRange.Text = myString '插入文本
    '以数字方式进行排序
    myRange.Sort Separator:="|", SortFieldType:=wdSortFieldNumeric, SortOrder:=wdSortOrderAscending
    With myRange.Find '删除新排序的数据文本
        .ClearFormatting
        .MatchWildcards = True
        .Execute findtext:="[0-9]@|", replacewith:="", Replace:=wdReplaceAll
    End With
    Set myRange = newDoc.Content '重新定义一个RANGE对象
    With myRange '转为表格并设置格式
        .ConvertToTable(Separator:=wdSeparateByParagraphs, numcolumns:=2).Style = "网格型"
        .CharacterWidth = wdWidthHalfWidth
        .Font.Name = "华文细黑"
        .Font.Size = 12
    End With
End Sub
'----------------------

sylun

老大的代码真妙，次序、全角数字、自动设定表格行数等问题全解决了。要好好消化。

以前也曾见过这样的表格（http://club.excelhome.net/dispbbs.asp?boardid=23&replyid=655681&id=209286&page=1&skin=0&Star=1）。从excel复制表格到word进行选择性粘贴为图片（图元文件）会有类似的效果。

zxyg5641

太深奥了……！我晕……高手就是高手……！

hanjingsnow

天呀,真是天才,我都看不懂,守柔太厉害了!

[em17]