望vba大神相助

[梁桑]

如图两张word表格，因为内容中有书签引用，引用内容过多会超出word表格1。求大神指教如何将表一超出的内容显示到表格2

[milaoshu1020]

dim objRange as range
set objRange = ... ' 第一页的包含超出表格内容的对象;

dim strContent as string
strContent = objRange.Text

dim objRange2 as Range
set objRange2 = ... ' 第二页填写超出表格内容的对象;

Const MaxLen as long = 500 ' 超过500个字符就分页,可根据情况自行调整;
if len(strContent) > maxlen then
    objrange.text = left(strcontent,maxlen)
    objrange2.text = mid(strcontent,maxlen+1)
end if

[梁桑]

引用 1 楼 脆皮大雪糕 的回复：

表格自动调整高度，并且跨页呢

两个表格不在一页，并且隔了几个表格，并且表格大小不能改动，跨页能实现吗？

[脆皮大雪糕]

简单的处理：先测试现有的表格里面最多能撑下多少个字，因为你的表格格式字体字间距行间距啥的一旦定死，能容纳下的字符也就固定了，硬代码判断一下超过字数的部分截断，显示到另外一个表格去。

[脆皮大雪糕]

表格自动调整高度，并且跨页呢

[梁桑]

引用 2 楼 milaoshu1020 的回复：

dim objRange as range
set objRange = ... ' 第一页的包含超出表格内容的对象;

dim strContent as string
strContent = objRange.Text

dim objRange2 as Range
set objRange2 = ... ' 第二页填写超出表格内容的对象;

Const MaxLen as long = 500 ' 超过500个字符就分页,可根据情况自行调整;
if len(strContent) > maxlen then
    objrange.text = left(strcontent,maxlen)
    objrange2.text = mid(strcontent,maxlen+1)
end if

感谢大神，但是这个方法做不到让表一内容撑满再换页。留下空白工作中不允许啊

[梁桑]

引用 4 楼 脆皮大雪糕 的回复：

简单的处理：先测试现有的表格里面最多能撑下多少个字，因为你的表格格式字体字间距行间距啥的一旦定死，能容纳下的字符也就固定了，硬代码判断一下超过字数的部分截断，显示到另外一个表格去。

表一内容会变动，标点符号，英文会导致每次可容纳字符数有出入

[脆皮大雪糕]

引用 5 楼 weixin_44095107 的回复:

[quote=引用 2 楼 milaoshu1020 的回复：]

dim objRange as range
set objRange = ... ' 第一页的包含超出表格内容的对象;

dim strContent as string
strContent = objRange.Text

dim objRange2 as Range
set objRange2 = ... ' 第二页填写超出表格内容的对象;

Const MaxLen as long = 500 ' 超过500个字符就分页,可根据情况自行调整;
if len(strContent) > maxlen then
    objrange.text = left(strcontent,maxlen)
    objrange2.text = mid(strcontent,maxlen+1)
end if

感谢大神，但是这个方法做不到让表一内容撑满再换页。留下空白工作中不允许啊[/quote] 米老鼠的意思就是假设500个字撑满，假设而已自己调整。看你的表格多少个字能撑满咯

[梁桑]

是的，但是因为内容变动，有时500个字撑满，有时490，有时520。因为第二页内容必须和前面接上，所以只能设定一个偏小的，也就是第一页会填不满

[milaoshu1020]

写好了,根据高度来切分:

Option Explicit

Public Sub test()
    Dim objRange As Range
    Set objRange = ActiveDocument.Tables(1).Cell(1, 1).Range ' Tabels(1)表示文档中的第一个表格Cell(1,1)为第1行第1列,可自行调整;
    
    objRange.Select
    Selection.MoveRight wdCharacter, 1
    Selection.MoveLeft wdCharacter, 1
    
    Do
        Dim dblTop As Double
        dblTop = Selection.Information(wdVerticalPositionRelativeToPage)
        
        If dblTop < 108 Then ' 自己调整,能显示的最后一行距页面顶端的高度;
            Exit Do
        End If
        
        Selection.MoveLeft wdCharacter, 1, wdExtend
    Loop
    
    Selection.MoveRight wdCharacter, 1, wdExtend
    Dim strContent As String
    strContent = Selection.Text
    Selection.Text = ""
    
    ActiveDocument.Tables(2).Cell(1, 1).Select ' 选中目标单元格,可自行调整;
    Selection.Text = strContent
    
    MsgBox Selection.Information(wdVerticalPositionRelativeToPage)
End Sub

运行示例:

示例下载地址:
链接：https://pan.baidu.com/s/1bf39rRkd6ZmJ6CvpblN8Qw
提取码：hrem

[梁桑]

引用 9 楼 milaoshu1020 的回复：

写好了,根据高度来切分:

Option Explicit

Public Sub test()
    Dim objRange As Range
    Set objRange = ActiveDocument.Tables(1).Cell(1, 1).Range ' Tabels(1)表示文档中的第一个表格Cell(1,1)为第1行第1列,可自行调整;
    
    objRange.Select
    Selection.MoveRight wdCharacter, 1
    Selection.MoveLeft wdCharacter, 1
    
    Do
        Dim dblTop As Double
        dblTop = Selection.Information(wdVerticalPositionRelativeToPage)
        
        If dblTop < 108 Then ' 自己调整,能显示的最后一行距页面顶端的高度;
            Exit Do
        End If
        
        Selection.MoveLeft wdCharacter, 1, wdExtend
    Loop
    
    Selection.MoveRight wdCharacter, 1, wdExtend
    Dim strContent As String
    strContent = Selection.Text
    Selection.Text = ""
    
    ActiveDocument.Tables(2).Cell(1, 1).Select ' 选中目标单元格,可自行调整;
    Selection.Text = strContent
    
    MsgBox Selection.Information(wdVerticalPositionRelativeToPage)
End Sub

运行示例:

示例下载地址:
链接：https://pan.baidu.com/s/1bf39rRkd6ZmJ6CvpblN8Qw
提取码：hrem

大神，这个方法应该对头，但我的文档里有好多表格，而且要操作的表格之间有隔离好几个表格，我不知道对应的表格应该填table（？）

[梁桑]

引用 10 楼 weixin_44095107 的回复：

[quote=引用 9 楼 milaoshu1020 的回复：]写好了,根据高度来切分:

Option Explicit

Public Sub test()
    Dim objRange As Range
    Set objRange = ActiveDocument.Tables(1).Cell(1, 1).Range ' Tabels(1)表示文档中的第一个表格Cell(1,1)为第1行第1列,可自行调整;
    
    objRange.Select
    Selection.MoveRight wdCharacter, 1
    Selection.MoveLeft wdCharacter, 1
    
    Do
        Dim dblTop As Double
        dblTop = Selection.Information(wdVerticalPositionRelativeToPage)
        
        If dblTop < 108 Then ' 自己调整,能显示的最后一行距页面顶端的高度;
            Exit Do
        End If
        
        Selection.MoveLeft wdCharacter, 1, wdExtend
    Loop
    
    Selection.MoveRight wdCharacter, 1, wdExtend
    Dim strContent As String
    strContent = Selection.Text
    Selection.Text = ""
    
    ActiveDocument.Tables(2).Cell(1, 1).Select ' 选中目标单元格,可自行调整;
    Selection.Text = strContent
    
    MsgBox Selection.Information(wdVerticalPositionRelativeToPage)
End Sub

运行示例:

示例下载地址:
链接：https://pan.baidu.com/s/1bf39rRkd6ZmJ6CvpblN8Qw
提取码：hrem

大神，这个方法应该对头，但我的文档里有好多表格，而且要操作的表格之间有隔离好几个表格，我不知道对应的表格应该填table（？）[/quote]还有，因为表格可容纳的行数是死的，能不能制定到第几行就跳转呢？

[梁桑]

引用 10 楼 weixin_44095107 的回复：

[quote=引用 9 楼 milaoshu1020 的回复：]写好了,根据高度来切分:

Option Explicit

Public Sub test()
    Dim objRange As Range
    Set objRange = ActiveDocument.Tables(1).Cell(1, 1).Range ' Tabels(1)表示文档中的第一个表格Cell(1,1)为第1行第1列,可自行调整;
    
    objRange.Select
    Selection.MoveRight wdCharacter, 1
    Selection.MoveLeft wdCharacter, 1
    
    Do
        Dim dblTop As Double
        dblTop = Selection.Information(wdVerticalPositionRelativeToPage)
        
        If dblTop < 108 Then ' 自己调整,能显示的最后一行距页面顶端的高度;
            Exit Do
        End If
        
        Selection.MoveLeft wdCharacter, 1, wdExtend
    Loop
    
    Selection.MoveRight wdCharacter, 1, wdExtend
    Dim strContent As String
    strContent = Selection.Text
    Selection.Text = ""
    
    ActiveDocument.Tables(2).Cell(1, 1).Select ' 选中目标单元格,可自行调整;
    Selection.Text = strContent
    
    MsgBox Selection.Information(wdVerticalPositionRelativeToPage)
End Sub

运行示例:

示例下载地址:
链接：https://pan.baidu.com/s/1bf39rRkd6ZmJ6CvpblN8Qw
提取码：hrem

大神，这个方法应该对头，但我的文档里有好多表格，而且要操作的表格之间有隔离好几个表格，我不知道对应的表格应该填table（？）[/quote]摸索了一下，搞定了