空格分隔的“导出到文本”Excel 宏问题

Question

我有以下 vba 宏 可以将选定的单元格导出到文本文件中。问题似乎是分隔符。

我需要所有东西都在一个准确的位置。我将每列的宽度设置为正确的宽度（9 for 9 like SSN），并且我在 Excel 工作表中将单元格字体设置为 Courier New(9pt)。

当我运行它时，它 REALLY 接近我需要的，但它似乎无法处理宽度仅为一个空格的列。

我会将 WHOLE 方法（和随附的函数）放在底部以供参考，但首先我想发布 我认为部分strong> 是我需要关注的地方。就是不知道用什么方法...

这是我相信我的问题所在（分隔符设置为delimiter = "" -->

' Loop through every cell, from left to right and top to bottom.
  For RowNum = 1 To TotalRows
     For ColNum = 1 To TotalCols
        With Selection.Cells(RowNum, ColNum)
        Dim ColWidth As Integer
        ColWidth = Application.RoundUp(.ColumnWidth, 0)
        ' Store the current cells contents to a variable.
        Select Case .HorizontalAlignment
           Case xlRight
              CellText = Space(Abs(ColWidth - Len(.Text))) & .Text
           Case xlCenter
              CellText = Space(Abs(ColWidth - Len(.Text)) / 2) & .Text & _
                         Space(Abs(ColWidth - Len(.Text)) / 2)
           Case Else
              CellText = .Text & Space(Abs(ColWidth - Len(.Text)))
        End Select
        End With


' Write the contents to the file.
   ' With or without quotation marks around the cell information.
            Select Case quotes
               Case vbYes
                  CellText = Chr(34) & CellText & Chr(34) & delimiter
               Case vbNo
                  CellText = CellText & delimiter
            End Select
            Print #FNum, CellText;

   ' Update the status bar with the progress.
            Application.StatusBar = Format((((RowNum - 1) * TotalCols) _
               + ColNum) / (TotalRows * TotalCols), "0%") & " Completed."

   ' Loop to the next column.
         Next ColNum
   ' Add a linefeed character at the end of each row.
         If RowNum <> TotalRows Then Print #FNum, ""
   ' Loop to the next row.
      Next RowNum

---

这就是整个SHEBANG！供参考，原文为HERE。

Sub ExportText()
'
' ExportText Macro
'
Dim delimiter As String
   Dim quotes As Integer
   Dim Returned As String


  delimiter = ""

  quotes = MsgBox("Surround Cell Information with Quotes?", vbYesNo)



' Call the WriteFile function passing the delimiter and quotes options.
      Returned = WriteFile(delimiter, quotes)

   ' Print a message box indicating if the process was completed.
      Select Case Returned
         Case "Canceled"
            MsgBox "The export operation was canceled."
         Case "Exported"
            MsgBox "The information was exported."
      End Select

   End Sub

   '-------------------------------------------------------------------

   Function WriteFile(delimiter As String, quotes As Integer) As String

   ' Dimension variables to be used in this function.
   Dim CurFile As String
   Dim SaveFileName
   Dim CellText As String
   Dim RowNum As Integer
   Dim ColNum As Integer
   Dim FNum As Integer
   Dim TotalRows As Double
   Dim TotalCols As Double


   ' Show Save As dialog box with the .TXT file name as the default.
   ' Test to see what kind of system this macro is being run on.
   If Left(Application.OperatingSystem, 3) = "Win" Then
      SaveFileName = Application.GetSaveAsFilename(CurFile, _
      "Text Delimited (*.txt), *.txt", , "Text Delimited Exporter")
   Else
       SaveFileName = Application.GetSaveAsFilename(CurFile, _
      "TEXT", , "Text Delimited Exporter")
   End If

   ' Check to see if Cancel was clicked.
      If SaveFileName = False Then
         WriteFile = "Canceled"
         Exit Function
      End If
   ' Obtain the next free file number.
      FNum = FreeFile()

   ' Open the selected file name for data output.
      Open SaveFileName For Output As #FNum

   ' Store the total number of rows and columns to variables.
      TotalRows = Selection.Rows.Count
      TotalCols = Selection.Columns.Count

   ' Loop through every cell, from left to right and top to bottom.
      For RowNum = 1 To TotalRows
         For ColNum = 1 To TotalCols
            With Selection.Cells(RowNum, ColNum)
            Dim ColWidth As Integer
            ColWidth = Application.RoundUp(.ColumnWidth, 0)
            ' Store the current cells contents to a variable.
            Select Case .HorizontalAlignment
               Case xlRight
                  CellText = Space(Abs(ColWidth - Len(.Text))) & .Text
               Case xlCenter
                  CellText = Space(Abs(ColWidth - Len(.Text)) / 2) & .Text & _
                             Space(Abs(ColWidth - Len(.Text)) / 2)
               Case Else
                  CellText = .Text & Space(Abs(ColWidth - Len(.Text)))
            End Select
            End With
   ' Write the contents to the file.
   ' With or without quotation marks around the cell information.
            Select Case quotes
               Case vbYes
                  CellText = Chr(34) & CellText & Chr(34) & delimiter
               Case vbNo
                  CellText = CellText & delimiter
            End Select
            Print #FNum, CellText;

   ' Update the status bar with the progress.
            Application.StatusBar = Format((((RowNum - 1) * TotalCols) _
               + ColNum) / (TotalRows * TotalCols), "0%") & " Completed."

   ' Loop to the next column.
         Next ColNum
   ' Add a linefeed character at the end of each row.
         If RowNum <> TotalRows Then Print #FNum, ""
   ' Loop to the next row.
      Next RowNum

   ' Close the .prn file.
      Close #FNum

   ' Reset the status bar.
      Application.StatusBar = False
      WriteFile = "Exported"
   End Function

---

进一步的发现

我发现下面的Case xlCenter 有问题。现在是星期五，我还没有完全理解它，但无论它在 case 中做什么，都在删除“”。我通过将所有列设置为左对齐来验证这一点，以便使用 Case Else 和 VIOLA！我的空间还在。我想了解为什么，但最终它是 A) 工作和 B) e.James 的解决方案看起来更好。

感谢您的帮助。

Dim ColWidth As Integer
        ColWidth = Application.RoundUp(.ColumnWidth, 0)
        ' Store the current cells contents to a variable.
        Select Case .HorizontalAlignment
           Case xlRight
              CellText = Space(Abs(ColWidth - Len(.Text))) & .Text
           Case xlCenter
              CellText = Space(Abs(ColWidth - Len(.Text)) / 2) & .Text & _
                         Space(Abs(ColWidth - Len(.Text)) / 2)
           Case Else
              CellText = .Text & Space(Abs(ColWidth - Len(.Text)))
        End Select

Answer 1

我认为问题源于您使用列宽作为要使用的字符数。当我在 Excel 中将列宽设置为 1.0 时，该列中显示的任何 数字 都会消失，并且 VBA 显示这些单元格的 .Text 属性是“”，这是有道理的，因为 @ 987654322@ 属性为您提供在 Excel 中可见的确切文本。

现在，您有几个选择：

1. 使用.Value 属性而不是.Text 属性。这种方法的缺点是它会丢弃您在电子表格中应用的任何数字格式（我不确定这是否是您的问题）

2. 不要使用列宽，而是在电子表格顶部（第 1 行）放置一行值以指示每列的适当宽度，然后在 VBA 代码中使用这些值而不是列宽度。然后，您可以在 Excel 中使列宽一点（以便文本正确显示）

我可能会选择#2，但当然，我对你的设置了解不多，所以我不能肯定。

编辑：以下解决方法可能会解决问题。我修改了您的代码以使用每个单元格的Value 和NumberFormat 属性，而不是使用.Text 属性。这应该可以解决单字符宽单元格的问题。

With Selection.Cells(RowNum, ColNum)
Dim ColWidth As Integer
ColWidth = Application.RoundUp(.ColumnWidth, 0)
'// Store the current cells contents to a variable.'
If (.NumberFormat = "General") Then
    CellText = .Text
Else
    CellText = Application.WorksheetFunction.Text(.NumberFormat, .value)
End If
Select Case .HorizontalAlignment
  Case xlRight
    CellText = Space(Abs(ColWidth - Len(CellText))) & CellText
  Case xlCenter
    CellText = Space(Abs(ColWidth - Len(CellText)) / 2) & CellText & _
               Space(Abs(ColWidth - Len(CellText)) / 2)
  Case Else
    CellText = CellText & Space(Abs(ColWidth - Len(CellText)))
End Select
End With

更新：要解决居中问题，我会执行以下操作：

Case xlCenter
  CellText = Space(Abs(ColWidth - Len(CellText)) / 2) & CellText
  CellText = CellText & Space(ColWidth - len(CellText))

这样，文本右侧的内边距会自动覆盖剩余的空间。

Answer 2

您是否尝试过将其保存为空格分隔？我的理解是它将列宽视为空格数，但尚未尝试所有方案。使用 Excel 2007 执行此操作似乎对我有用，或者我对您的问题还不够了解。我确实尝试过使用 width=1 的列，并将其呈现为结果文本文件中的 1 个空格。

ActiveWorkbook.SaveAs Filename:= _
    "C:\Book1.prn", FileFormat:= _
    xlTextPrinter, CreateBackup:=False