Word從Excel選擇中粘貼所有行，而不是單獨選擇

我想在 Excel 電子表格中選擇一些行，然后使用Selection.PasteExcelTable. 假設宏是由 Word 中的按鈕觸發的：

Private Sub CommandButton1_Click()

Dim xlApp As Object
Dim xlSheet As Object
Dim table As Object

Const strWorkbookName As String = "PATH"

Set xlApp = CreateObject("Excel.Application")
Set xlSheet = xlApp.Workbooks.Open(FileName:=strWorkbookName).Sheets("Sheet1")

' returns a range of rows
select_rows_with_given_string("TEST", xlSheet).Copy
Selection.PasteExcelTable False, False, False

End Sub

在我的情況下，select_rows_with_given_string回傳第 1、2、5 和 6 行。當我在 Word 中觸發按鈕時，將粘貼第 1、2、3、4、5 和 6 行而不是 1、2、5、6。當我select_rows_with_given_string在 excel 中使用然后將其粘貼到電子表格中時，一切正常。只有 1,2,5,6 被粘貼。如何在 Word 中解決此問題。

PS：如果我在 Excel 中手動選擇一些不相鄰的行并將它們（ctrl v）粘貼到 Word 中，也會發生同樣的事情。之間的所有行也被粘貼。

下面是選擇函式：

Function select_rows_with_given_string(searchString As String, xlSheet As Object) As Object
 
 Dim myUnion As Object
 Dim Row As Integer
 
 endCol = "N"
 endRow = 46
 startRow = 3
 
 xlSheet.Activate
 Set myUnion = Excel.Range("A1:" & endCol & startRow - 1)
 
 For Row = startRow To endRow
    If Excel.Range("A" & Row).Value = searchString Then
        If Not myUnion Is Nothing Then
            Set myUnion = Excel.Union(myUnion, Excel.Range("A" & Row & ":" & endCol & Row))
        Else
            Set myUnion = Excel.Range("A" & Row & ":" & endCol & Row)
        End If
    End If
 Next Row
 
 Set select_rows_with_given_string = myUnion
 
 End Function

uj5u.com熱心網友回復：

請嘗試下一個改編的功能。它隱藏不需要的行并回傳要復制的可見單元格。以及使所有行可見的隱藏范圍：

Function select_rows_with_given_string(searchString As String, xlSheet As Object, xlApp As Object) As Variant
 Dim rngH As Object, allRng As Object, endCol As String
 Dim Row As Integer, endRow As Long, startRow As Long
 
 endCol = "N": endRow = 46: startRow = 3
 Set allRng = xlSheet.Range("A1:" & endCol & endRow - 1) 'all the range to be returned
 
 For Row = startRow To endRow
    If xlSheet.Range("A" & Row).Value <> searchString Then '<>!!!
        If rngH Is Nothing Then
            Set rngH = xlSheet.Range("A" & Row)
        Else
            Set rngH = xlApp.Union(rngH, xlSheet.Range("A" & Row))
        End If
    End If
 Next Row
 rngH.EntireRow.Hidden = True 'hide all unnecessary rows...
 select_rows_with_given_string = Array(allRng.SpecialCells(12), rngH)
End Function

對于任何保留searchString, whenSpecialCells(xlCellTypeVisible)將回傳錯誤的行的情況，它需要一些錯誤處理。

您現有的代碼應按以下方式進行調整：

Private Sub CommandButton1_Click_()
 Dim xlApp As Object, xlSheet As Object, table As Object, arr

 Const strWorkbookName As String = "PATH"

 Set xlApp = CreateObject("Excel.Application")
 Set xlSheet = xlApp.Workbooks.Open(FileName:=strWorkbookName).Sheets("Sheet1")

 ' returns a range of ranges:
 arr = select_rows_with_given_string("TEST", xlSheet, xlApp)
 arr(0).Copy
 Selection.PasteExcelTable False, False, False
 arr(1).EntireRow.Hidden = False 'unhide the previously hidden rows...
End Sub

請測驗它并發送一些反饋。

uj5u.com熱心網友回復：

我找到了一個非常hacky的方法來做到這一點。基本上我復制行，制作一個新作業表，然后將這些行粘貼到那里，然后從新作業表中再次復制它們，然后洗掉作業表。必須有更好的方法嗎？

Private Sub CommandButton1_Click()

Dim xlApp As Object
Dim xlSheet As Object
Dim table As Object

Const strWorkbookName As String = "PATH"

Set xlApp = CreateObject("Excel.Application")
Set xlSheet = xlApp.Workbooks.Open(FileName:=strWorkbookName).Sheets("Sheet1")

' returns a range of rows
select_rows_with_given_string("TEST", xlSheet).Copy

' sketchy fix
Excel.Sheets.Add After:=Excel.ActiveSheet
Excel.ActiveSheet.Paste
Excel.Selection.Copy
Excel.ActiveSheet.Delete

Selection.PasteExcelTable False, False, False

標籤：擅长 vba ms-word

上一篇：查找一個月中的作業日excelVBA

下一篇：VBA如果值與特定Dim的名稱相同，則獲取值的Dim