时间戳

首页 > 解决方案 > VBA Word 复制表的值而不引用表的序列号

vba - VBA Word 复制表的值而不引用表的序列号

问题描述

我有一个 Word 文件，其中正在更改表的数量。我需要从第三个或第四个表中复制值（它总是会改变）。

该表始终具有 1 行和 2 列（其他表完全不同），第一列始终具有文本“温度”，第二列中的文本正在更改，我需要复制该文本。

如果有帮助，在表格开始之前总会有“规格”一词。

在我意识到表的数量不是永久的之前，我使用了该代码。（如果有帮助的话）

那么，您能否建议如何自动化该过程？

Sub Demo()
Dim wsCopy as Word.Document
Dim wsDest as Worksheet

    Set wsCopy = Documents(1)
    Set wsDest = ThisWorkbook.Worksheets(1)
    
Application.ScreenUpdating = False
With wsCopy.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "Temperature"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
  End With
  Do While .Find.Execute
    If .Information(wdWithInTable) = True Then
      With .Cells(1)
        If .ColumnIndex = 2 Then
          Set Rng = .Range
          Rng.End = Rng.End - 1
          Rng.Copy
          Exit Do
        End If
      End With
    End If
    .Collapse wdCollapseEnd
  Loop
End With
Application.ScreenUpdating = True
    wsDest.Cells(ActiveCell.Row, "N").PasteSpecial Paste:=xlPasteValues
End Sub

标签： vbams-word

解决方案

For example:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Text = "Specifications"
    .Execute
    If .Found = False Then Exit Sub
  End With
  .Collapse wdCollapseEnd
  .Find.Text = "Temperature"
  Do While .Find.Execute
    If .Information(wdWithInTable) = True Then
      If .Cells(1).ColumnIndex = 1
        wsDest.Cells(ActiveCell.Row, "N").Value = _
          Split(.Tables(1).Range.Cells(2).Range.Text,vbCr)(0)
        Exit Do
      End If
    End If
    .Collapse wdCollapseEnd
  Loop
End With
Application.ScreenUpdating = True
End Sub

推荐阅读