選択であなたの最初の行がフィールドの幅FieldWidth = Cells(1, ColumnCount).Valueが含まれているように見えます。あなたの問題の説明では、データの場所とフィールドのサイズを述べました。あなたはこの情報をどこかに持っている必要があります。あなたは、テキストファイルの出力を調整することができるファイル内の別のシートに置くことができますか、それらの値を定数としてVBAコードに入れたり、クラスを作成することができます。このようなものを使用すると、必要に応じてフィールドを再定義できます。以下の例では、モジュールで単純なクラスといくつかのプライベート関数を使用しています。
"FieldControl"という名前のシートを追加して列に適切な値を配置する必要があります。GetFieldControl関数を参照してください。
あなたはあなたのマクロ、作業帳に以下の参照にを追加する必要があります：コードをテストするために、私は次のように使用しました。 [ツール]メニューの[VBAエディタ]で[参照設定]を選択し、ダイアログボックスが表示されたら[Microsoft Scripting Runtime]を選択します。 （Tools-> References）
すべてのことがコードに関連して、これには改善が加えられています。
あなたの努力
クラス（インサート>クラス）と幸運がclFieldにデフォルト名を変更（あなたが好きそれを呼び出すが、一致させるために、DimステートメントGetFieldControl機能を更新することを確認することができますあなたはそれを与えた名前を付けます。）
Option Explicit
Public Enum eFieldType
Number
Text
End Enum
Public Name As String
Public Size As Long
Public StartPos As Long
Public Value As String
Public FieldType As eFieldType
いくつかの更新
Option Explicit
Option Base 1 'This makes any defined array start a 1 rather than 0
Sub Export_Selection_As_Fixed_Length_File()
' Dimension all variables.
Dim DestinationFile, CellValue, Filler_Char_To_Replace_Blanks As String
Dim FileNum, ColumnCount, RowCount, FieldWidth As Integer
Dim sht As Worksheet
Dim outputRecord() As String
'Below are options in case you want to change the folder where VBA stores the .txt file
'We use ActiveWorkbook.Path in this example
'ActiveWorkbook.Path 'the activeworkbook
'ThisWorkbook.Path 'the workbook with the code
'CurDir 'the current directory (when you hit File|open)
'If a cell is blank, what character should be used instead
Filler_Char_To_Replace_Blanks = "+"
'Check if the user has made any selection at all
If Selection.Cells.Count < 2 Then
MsgBox "Nothing selected to export"
Selection.Activate
End
End If
'This is the destination file name.
DestinationFile = ActiveWorkbook.Path & "\textfile.txt" 'This was changed to the DOS version of directory separator
On Error GoTo catchFileOpenError 'Poor man's version of Try/Catch
'Get a FileSystemObject using the MSFT Scripting Runtime reference
Dim fd As Scripting.FileSystemObject
Set fd = New Scripting.FileSystemObject
Dim outputFile As Object
Set outputFile = fd.CreateTextFile(DestinationFile, True, False)
' Turn error checking on.
On Error GoTo 0
Dim record As Scripting.Dictionary
'Call a private function that gets the filed control information from the
'Sheet titled FieldControl and the associated range
Set record = GetFieldControl(ActiveWorkbook.Sheets("FieldControl").Range("A2:D7"))
'Declare enumerators to loop through the selection
Dim dataRow As Range
Dim dataFld As Range
'Declare the output buffer, 80 characters
Dim outputBuffer(80) As Byte
'loop thru the selection row by row
For Each dataRow In Selection.Rows
'Initialize buffer to empty value defined by the second parameter
Call InitOutputBuffer(outputBuffer, Filler_Char_To_Replace_Blanks)
'Loop thru each field in the row
For Each dataFld In dataRow.Columns
'Copy the input value into the output byte array
Call CopyStringToByteArray(outputBuffer, StrConv(Trim(CStr(dataFld.Value2)), vbFromUnicode), _
record(dataFld.Column).StartPos, record(dataFld.Column).FieldType, record(dataFld.Column).Size)
Next dataFld
'Write the record to the text file but first convert ASCII Byte to Unicode String
'Also this method places CR/LF as part of the output to the file
outputFile.WriteLine StrConv(outputBuffer, vbUnicode)
Next dataRow
' Close destination file.
outputFile.Close
Selection.Activate
Workbooks.OpenText Filename:=DestinationFile
Exit Sub
catchFileOpenError: 'Catch the error after trying if openning the file fails
On Error GoTo 0
MsgBox "Cannot open filename " & DestinationFile
Selection.Activate
End Sub
'***********************************************************************************
'*
'* PARAMETERS:
'* outBuf is the updated buffer
'* inBuf is the input buffer that needs to be copied to the output buffer (buffer)
'* startCol is the starting column for the field
'* fldTy is the field type as defined by the class enumerator eFieldType
'* fldLen is the length of the field as defined on the control sheet
Private Sub CopyStringToByteArray(ByRef outBuf() As Byte, ByRef inBuf() As Byte, _
ByVal startCol As Long, ByRef fldTy As eFieldType, ByVal fldLen As Long)
Dim idx As Long
If fldTy = Text Then 'Left Justified
For idx = LBound(inBuf) To UBound(inBuf)
outBuf(startCol) = inBuf(idx)
startCol = startCol + 1
Next idx
Else 'Right Justified
Dim revIdx As Long
revIdx = startCol + fldLen - 1
For idx = UBound(inBuf) To LBound(inBuf) Step -1
outBuf(revIdx) = inBuf(idx)
revIdx = revIdx - 1
Next idx
End If
End Sub
'***************************************************************************
'* InitOutputBuffer
'* PARAMETERS:
'* buffer is the buffer to initialize
'* initVal is a string containing the value used to initialize the buffer
Private Sub InitOutputBuffer(ByRef buffer() As Byte, ByVal initVal As String)
Dim byInitVal() As Byte 'Byte array to hold the values from the string conversion
byInitVal = StrConv(initVal, vbFromUnicode) 'convert the string into an ASCII array
Dim idx As Long
For idx = LBound(buffer) To UBound(buffer)
buffer(idx) = byInitVal(0)
Next idx
'buffer(81) = Asc(Chr(13)) 'Carriage Return Character
'buffer(82) = Asc(Chr(10)) 'Line Feed Character
End Sub
'*******************************************************************************
'*
'* GetFieldControl
'* PARAMETERS:
'* ctrlRng is the range on a worksheet where the field control info is
'* found
'* REMARKS:
'* The range needs to have the following columns: Name, Size, Start Postion
'* and Type. Type values can be Text or Number
Private Function GetFieldControl(ByRef ctrlRng As Range) As Scripting.Dictionary
Dim retVal As Scripting.Dictionary
Set retVal = New Scripting.Dictionary
'format of control range is : Name, Size, Start Position, Type
Dim fldInfoRow As Range
Dim fld As clField 'A class that holds the control values from the work sheet
Dim colCnt As Long: colCnt = 1 'Becomes the key for the dictionary
For Each fldInfoRow In ctrlRng.Rows
Set fld = New clField
fld.Name = fldInfoRow.Value2(1, 1) 'Name of field in data table
fld.Size = fldInfoRow.Value2(1, 2) 'Output Size of field
fld.StartPos = fldInfoRow.Value2(1, 3) 'Output starting position for this field
Select Case fldInfoRow.Value2(1, 4) 'Controls how the output value is formated
Case "Text" ' Text left justified, Numbers are right justified
fld.FieldType = Text
Case "Number"
fld.FieldType = Number
Case Default
fld.FieldType = Text
End Select
retVal.Add Key:=colCnt, Item:=fld 'Add the key and the fld object to the dictionary
colCnt = colCnt + 1 'This key value is mapped to the column number in the input data table
Next fldInfoRow
'Return the scripting Dictionary
Set GetFieldControl = retVal
End Function
ない上品なソリューションが、私はWRIしたいとモジュールを列番号に基づいて文字列の先頭にいくつかのスペースを追加する関数。 – Absinthe
Excelシートを固定幅スタイルでエクスポートするとどうなりますか？ https://superuser.com/questions/100433/export-an-excel-spreadsheet-to-fixed-width-text-file –
@Absinthe私はそれについて考えましたが、必要なスペースの数はいくつかの異なる要因。文字列の長さだけではありません。 – Robby