[英]Space Delimited 'Export To Text' Excel Macro Issue
I have the below vba macro to Export the selected cells into a text file. 我有以下vba宏将选定的单元格导出到文本文件中。 The problem seems to be the delimiter. 问题似乎是分隔符。
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. 我将把WHOLE方法( 和附带的函数 )放在底部作为参考,但首先我想发布我认为需要关注的部分。 I just don't know in what way... 我只是不知道以什么方式......
This is where I believe my 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 ! 这是整个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
I discovered that there is something wrong with Case xlCenter
below. 我发现下面的Case xlCenter
有问题。 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 " ". 这是星期五,我还没有能够绕过它,但在这种case
它正在做的就是删除“”。 I verified this by setting all columns to Left Justified so that the Case Else
would be used instead and VIOLA! 我通过将所有列设置为Left Justified来验证这一点,以便使用Case Else
代替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. 我想理解为什么但最终它是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
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: 现在,您有几个选择:
Use the .Value
property instead of the .Text
property. 使用.Value
属性而不是.Text
属性。 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. 不是使用列宽,而是在电子表格的顶部放置一行值(在第1行中)以指示每列的适当宽度,然后在VBA代码中使用这些值而不是列宽。 Then, you can make your columns a little bit wider in Excel (so that the text displays properly) 然后,您可以在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. 我修改了您的代码以使用每个单元格的Value
和NumberFormat
属性,而不是使用.Text
属性。 This should take care of the problems with one-character wide cells. 这应该解决单字符宽单元格的问题。
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. 这样,文本右侧的填充将自动覆盖剩余空间。
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. 使用Excel 2007执行此操作似乎对我有用,或者我对您的问题不够了解。 I did try with a column with width=1 and it rendered that as 1 space in the resulting text file. 我尝试使用width = 1的列,并在生成的文本文件中将其渲染为1个空格。
ActiveWorkbook.SaveAs Filename:= _
"C:\Book1.prn", FileFormat:= _
xlTextPrinter, CreateBackup:=False
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.