Geek Answers Handbook

Export To Text Space Macro Issue

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

I need everything to be in the exact position. I have the width of each column equal to the correct width (9 for 9, like SSN), and I have a font of cells like Courier New (9pt) in an Excel worksheet.

When I run this, it comes out REALLY next to what I need, but it does not seem to be related to columns that represent only one space in width.

I will put the WHOLE method (and the companion function) below for reference, but first I would like to post the THINK part I where I need to focus on. I just don’t know how ...

Here I believe my problem (the delimiter is set to 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 ALL 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 found that something was wrong with Case xlCenter . This is Friday, and I have not yet been able to circle my head, but everything that he does in this case deleted the "". I checked this by setting all the columns to the left to use Case Else instead and VIOLA! My space is left. I would like to understand why, but in the end it A) works, and B) the e.James solution looks anyway.

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
+4
source share
2 answers

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

Now you have a couple of options:

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

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

I would probably go with No. 2, but, of course, I know little about your setup, so I can’t say for sure.

edit: The next workaround may do the trick. I modified your code to use the Value and NumberFormat for each cell instead of using the .Text property. This should take care of problems with single-character 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 solve the centering problem, I would do the following:

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

Thus, the gasket on the right side of the text will automatically cover the remaining space.

+1
source

Did you try to just save it as limited space? I understand that it will handle the column width as # spaces, but did not try all the scripts. Doing this with Excel 2007 seems to work for me, or I don't understand your problem enough. I tried using a column with width = 1 and it displayed it as 1 place in the resulting text file.

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

More articles: