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

I have the below vba macro to Export the selected cells into a text file. The problem seems to be the delimiter.

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

I need everything to be in an exact position. I have each column's width set to the correct width(9 for 9 like SSN) and I have the cells font as Courier New(9pt) in an Excel Sheet.

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

When I run this it comes out REALLY close to what I need but it doesn't seem to deal with the columns that are just a single space in width.

当我运行它的时候，它非常接近于我所需要的，但它似乎并没有处理那些只是一个宽度的单个空间的列。

I will put the WHOLE method (and accompanying function) at the bottom for reference but first I'd like to post the portion I THINK is where I need to focus on. I just don't know in what way...

我将把整个方法(以及伴随函数)放在底部以供参考，但是首先我想要发布我认为需要关注的部分。我只是不知道以什么方式……

This is where I believe my issue is(delimiter is set to delimiter = "" -->

这就是我认为我的问题所在(delimiter被设置为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

---

This is the WHOLE SHEBANG! For reference the original is 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

---

Further Discoveries

I discovered that there is something wrong with Case xlCenter below. It's Friday and I haven't been able to wrap my head around it yet but whatever it is doing in that case was removing the " ". I verified this by setting all columns to Left Justified so that the Case Else would be used instead and VIOLA! My space remained. I would like to understand why but in the end it is A) working and B) e.James's solution looks better anyway.

我发现下面的案例xlCenter有问题。现在是星期五，我还没回过神来，但不管它在做什么，它都在移除“”。我通过设置所有列的左对齐来验证这一点，这样就可以用其他的例子来代替和中提琴了!我的空间仍然存在。我想知道为什么，但最后是A)工作和B) e)。不管怎样，詹姆斯的解决方案看起来更好。

Thanks for the help.

谢谢你的帮助。

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

2 个解决方案

#1

I think the problem stems from your use of the column width as the number of characters to use. When I set a column width to 1.0 in Excel, any numbers displayed in that column simply disappear, and VBA shows that the .Text property for those cells is "", which makes sense, since the .Text property gives you the exact text that is visible in Excel.

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

Now, you have a couple of options here:

现在，你有几个选择:

1. Use the .Value property instead of the .Text property. The downside of this approach is that it will discard any number formatting that you have applied in the spreadsheet (I'm not sure if this is a problem in your case)

   使用. value属性而不是. text属性。这种方法的缺点是它将丢弃您在电子表格中应用的任何数字格式(我不确定这在您的案例中是否是一个问题)

2. Instead of using the column widths, place a row of values at the top of your spreadsheet (in row 1) to indicate the appropriate width for each column, then use those values in your VBA code instead of the column width. Then, you can make your columns a little bit wider in Excel (so that the text displays properly)

   不要使用列宽度，在电子表格的顶部(第1行)放置一行值，以指示每个列的适当宽度，然后在VBA代码中使用这些值，而不是列宽度。然后，您可以在Excel中将列设置得稍微宽一点(以便文本能够正确显示)

I would probably go with #2 but, of course, I don't know much about your setup, so I can't say for sure.

我可能会选2号，但是，当然，我不太了解你的设置，所以我不能肯定。

edit: The following workaround may do the trick. I modified your code to make use the Value and NumberFormat properties of each cell, instead of using the .Text property. This should take care of the problems with one-character wide cells.

编辑:下面的解决方案可以达到这个目的。我修改了您的代码，以便使用每个单元格的值和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

update: to take care of the centering problem, I would do the following:

更新:为了解决中心问题，我将做以下工作:

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

This way, the padding on the right side of the text will automatically cover the remaining space.

这样，文本右边的填充将自动覆盖其余的空间。

#2

Have you tried just saving it as space delimited? My understanding is it will treat column width as # of spaces, but haven't tried all scenarios. Doing this with Excel 2007 seems to work for me, or I don't understand enough of your issue. I did try with a column with width=1 and it rendered that as 1 space in the resulting text file.

你试过把它存为分隔符吗?我的理解是，它将把列宽度视为空格的#，但还没有尝试过所有的场景。用Excel 2007做这个似乎对我有用，或者我对你的问题了解不够。我尝试了一个宽度为1的列，它在结果文本文件中显示为1个空格。

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