vba 空格分隔的“导出到文本”Excel 宏问题
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/2074740/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Space Delimited 'Export To Text' Excel Macro Issue
提问by Refracted Paladin
I have the below vba macroto 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 REALLYclose 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 WHOLEmethod (and accompanying function) at the bottom for reference but first I'd like to post the portion I THINKis where I need to focus on. I just don't know in what way...
我将把WHOLE方法（和伴随的功能在底部以供参考），但第一我想发布部我认为是我需要关注。就是不知道用什么方法...
This is where I believemy issue is(delimiter is set to 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.
这就是整个SHEBANG！供参考，原件在这里。
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 xlCenterbelow. It's Friday and I haven't been able to wrap my head around it yet but whatever it is doing in that casewas removing the " ". I verified this by setting all columns to Left Justified so that the Case Elsewould 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.
我发现Case xlCenter下面有问题。现在是星期五，我还无法理解它，但是无论它在做什么，都在case删除“ ”。我通过将所有列设置为左对齐来验证这一点，以便Case Else使用 和 VIOLA！我的空间还在。我想了解为什么，但最终它是 A) 工作和 B) e.James 的解决方案无论如何看起来更好。
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
采纳答案by e.James
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 numbersdisplayed in that column simply disappear, and VBA shows that the .Textproperty for those cells is "", which makes sense, since the .Textproperty 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:
现在，您有几个选择：
Use the
.Valueproperty instead of the.Textproperty. 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)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)
使用
.Value属性而不是.Text属性。这种方法的缺点是它会丢弃您在电子表格中应用的任何数字格式（我不确定这是否是您的问题）不要使用列宽，而是在电子表格的顶部（第 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 Valueand NumberFormatproperties of each cell, instead of using the .Textproperty. This should take care of the problems with one-character wide cells.
编辑：以下解决方法可能会奏效。我修改了您的代码以使用每个单元格的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
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.
这样，文本右侧的填充将自动覆盖剩余空间。
回答by Jim L
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
