空格分隔“导出到文本”Excelmacros问题

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

我需要一切准确的位置。 我有每个列的宽度设置为正确的宽度（ 9像9像SSN ），我有单元格字体作为新快报（ 9pt ）在Excel表中。

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

我将把WHOLE方法（ 和伴随函数 ）放在底部作为参考，但首先我想发布我认为是我需要关注的部分。 我只是不知道如何…

这是我相信我的问题是（分隔符设置为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 ！ 为了参考原件是在这里 。

 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 ，不pipe它在做什么，都把“”去掉了。 我通过将所有列设置为Left Justified来validation此情况，以便使用Case Else和VIOLA！ 我的空间依然存在 我想明白为什么，但最后是A）工作和B）e.James的解决scheme看起来好多了。

谢谢您的帮助。

 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属性是“”，这是.Text ，因为.Text属性为您提供了精确的文本在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似乎为我工作，或者我不明白你的问题。 我曾尝试与宽度= 1的列，并将其作为结果文本文件中的1空格。

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