Leerzeichenbegrenztes Excel-Makro 'Exportieren in Text' Problem

Question

Ich habe die folgenden VBA-Makro um die ausgewählten Zellen in eine Textdatei zu exportieren. Das Problem scheint das Begrenzungszeichen zu sein.

Ich muss alles genau an der richtigen Stelle haben. Ich habe die Breite jeder Spalte auf die richtige Breite eingestellt ( 9 für 9 wie SSN ) und die Schriftart der Zellen ist Courier New( 9pt ) in einer Excel-Tabelle.

Wenn ich dies ausführe, kommt folgendes heraus WIRKLICH nahe an dem, was ich brauche, aber es scheint nicht mit den Spalten, die nur ein einzelnes Leerzeichen in der Breite sind zu behandeln.

Ich werde die WHOLE Methode ( und begleitende Funktion ) am Ende als Referenz, aber zuerst möchte ich den Teil veröffentlichen ICH DENKE ist der Punkt, auf den ich mich konzentrieren muss. Ich weiß nur nicht, auf welche Weise...

Dies ist der Ort, an dem Ich glaube mein Problem ist (Begrenzer ist eingestellt auf 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

---

Dies ist die GANZES RHEBANG ! Als Referenz ist das Original HIER .

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

---

Weitere Entdeckungen

Ich habe entdeckt, dass etwas nicht stimmt mit Case xlCenter unten. Es ist Freitag und ich habe es noch nicht ganz verstanden, aber was auch immer es in diesem case war das Entfernen des " ". Ich habe dies überprüft, indem ich alle Spalten auf Linksbündig gesetzt habe, so dass die Case Else verwendet werden, und VIOLA! Mein Platz blieb. Ich würde gerne verstehen, warum das so ist, aber im Endeffekt funktioniert es A) und B) sieht die Lösung von e.James sowieso besser aus.

Vielen Dank für die Hilfe.

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

Ich denke, das Problem rührt daher, dass Sie die Spaltenbreite als Anzahl der zu verwendenden Zeichen verwenden. Wenn ich in Excel eine Spaltenbreite von 1,0 einstelle, werden alle Zahlen in dieser Spalte angezeigt werden, verschwinden einfach, und VBA zeigt an, dass die .Text Eigenschaft für diese Zellen ist "", was sinnvoll ist, da die .Text gibt Ihnen den genauen Text an, der in Excel sichtbar ist.

Sie haben hier mehrere Möglichkeiten:

1. Verwenden Sie die .Value statt der Eigenschaft .Text Eigentum. Der Nachteil dieses Ansatzes ist, dass alle Zahlenformatierungen, die Sie in der Kalkulationstabelle vorgenommen haben, verworfen werden (ich bin mir nicht sicher, ob dies in Ihrem Fall ein Problem darstellt)

2. Anstatt die Spaltenbreiten zu verwenden, sollten Sie eine Reihe von Werten am oberen Rand Ihres Arbeitsblatts (in Zeile 1) platzieren, um die entsprechende Breite für jede Spalte anzugeben, und dann diese Werte in Ihrem VBA-Code anstelle der Spaltenbreite verwenden. Anschließend können Sie Ihre Spalten in Excel etwas breiter machen (damit der Text richtig angezeigt wird)

Ich würde mich wahrscheinlich für die Nummer 2 entscheiden, aber natürlich weiß ich nicht viel über Ihre Einrichtung, daher kann ich das nicht mit Sicherheit sagen.

bearbeiten: Die folgende Abhilfe kann Abhilfe schaffen. Ich habe Ihren Code so geändert, dass er die Value y NumberFormat Eigenschaften jeder Zelle, anstatt die .Text Eigentum. Damit sollten die Probleme mit ein Zeichen breiten Zellen behoben sein.

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

aktualisieren: Um das Problem der Zentrierung zu lösen, würde ich wie folgt vorgehen:

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

Auf diese Weise wird der verbleibende Platz automatisch durch die Füllung auf der rechten Seite des Textes abgedeckt.

Answer 2

Haben Sie versucht, sie einfach als durch Leerzeichen getrennte Datei zu speichern? Meines Wissens wird die Spaltenbreite als Anzahl der Leerzeichen behandelt, aber ich habe nicht alle Szenarien ausprobiert. Wenn ich das mit Excel 2007 mache, scheint es zu funktionieren, oder ich verstehe nicht genug von Ihrem Problem. Ich habe es mit einer Spalte mit Breite = 1 versucht, und sie wurde in der resultierenden Textdatei als 1 Leerzeichen dargestellt.

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