在Excel VBScript代码中自动拟合行

Question

我正在使用命令

.Columns("A:I").EntireColumn.AutoFit

运行循环后，要在我的Excel VBScript中自动授权列，但是当我放置命令时，我会遇到错误：

Rows(xCount).EntireRow.AutoFit

自动高度适合表格中的行。

您能告诉我如何自动化电子表格中的所有行吗？

这是我的完整代码：

Sub SearchFolders()
'UpdatebySUPERtoolsforExcel2016
    Dim xFso As Object
    Dim xFld As Object
    Dim xUpdate As Boolean
    Dim xCount As Long
    On Error GoTo ErrHandler
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a forlder"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    xStrSearch = "failed"
    xUpdate = Application.ScreenUpdating
    Application.ScreenUpdating = False
    Set xOut = wsReport
    xRow = 1
    With xOut
        .Cells(xRow, 1) = "Workbook"
        .Cells(xRow, 2) = "Worksheet"
        .Cells(xRow, 8) = "Unit"
        .Cells(xRow, 9) = "Status"
        Set xFso = CreateObject("Scripting.FileSystemObject")
        Set xFld = xFso.GetFolder(xStrPath)
        xStrFile = Dir(xStrPath & "*.xlsx")
        Do While xStrFile <> ""
            Set xWb = Workbooks.Open(Filename:=xStrPath & "" & xStrFile, UpdateLinks:=0, ReadOnly:=True, AddToMRU:=False)
            For Each xWk In xWb.Worksheets
                Set xFound = xWk.UsedRange.Find(xStrSearch, LookIn:=xlValues)
                If Not xFound Is Nothing Then
                    xStrAddress = xFound.Address
                End If
                Do
                    If xFound Is Nothing Then
                        Exit Do
                    Else
                        xCount = xCount + 1
                        xRow = xRow + 1
                        .Cells(xRow, 1) = xWb.Name
                        .Cells(xRow, 2) = xWk.Name
                        .Cells(xRow, 3) = xFound.Address
                        WriteDetails rCellwsReport, xFound
                    End If
                    Set xFound = xWk.Cells.FindNext(After:=xFound)
                Loop While xStrAddress <> xFound.Address
            Next
            xWb.Close (False)
            xStrFile = Dir
        Loop
        .Columns("A:I").EntireColumn.AutoFit
        .Rows(xCount).EntireRow.AutoFit
    End With
    MsgBox xCount & "cells have been found", , "SUPERtools for Excel"
ExitHandler:
    Set xOut = Nothing

    Application.ScreenUpdating = xUpdate
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub
Private Sub WriteDetails(ByRef xReceiver As Range, ByRef xDonor As Range)
  xReceiver.Value = xDonor.Parent.Name
  xReceiver.Offset(, 1).Value = xDonor.Address
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  ' Copy the row of the Donor to the receiver starting from column D.
  ' Since you want to preserve formats, we use the .Copy method
    xDonor.EntireRow.Resize(, 100).Copy xReceiver.Offset(, 2)
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Set xReceiver = xReceiver.Offset(1)
End Sub

Answer 1

您是否缺少前面的。？

Rows(xCount).EntireRow.AutoFit应该是 .Rows(xCount).EntireRow.AutoFit