Excel VBA Export To Text File with Fixed Column Wi

2019-08-04 01:30发布

This picture is my excel data format, I wanna export it into text file with fixed column width, example:

User ID    Total     Work
001        22:00     17:00
002        4:00      4:00

How to set PERSONAL.XLSB auto run my script when always open a newly created specific name workbook?

I tried to add this script into XLSB > ThisWorkBook

Private WithEvents App As Application

Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
    Application.Run ("PERSONAL.XLSB!TASUBSPayroll")
End Sub

After open the specific name workbook, it was exported a text file without export the data out:

User ID    Total     Work

I think it was run the macro on PERSONAL.XLSB only and not run to my specific name workbook.

http://i.imgur.com/EETLL6V.jpg

I was add the these code into the module name as "TASUBSMacro" in VBAProject(PERSONAL.XLSB) but it still not run the macro for the TotalTimeCardReport.xlsx.

Private Sub Workbook_Open()

Run "MyMacro"

End Sub

This TotalTimeCardReport.xlsx was exported from some software and auto open it with excel. But I was combined with the PERSONAL.XLSB and it was still not run the macro - module from PERSONAL.XLSB to TotalTimeCardReport.xlsx.

1条回答
Juvenile、少年°
2楼-- · 2019-08-04 02:12

Loop all rows and all cells. Send each value to a padspace function. Build the string from for each cells value with spaces padded after the cell value.

You will have to add a reference to you workbook. In the VBA IDE go to the tools pull down menu and select references. Then scroll down and select "Microsoft Scripting Runtime". Then hit OK.

Adjust the pad space function call argument to a number that fits the data that you have in your spreadsheet. So you will change the 20 in the line with the padspace call. PadSpace(20, len(cellValue))

This will do all rows and columns.

Public Sub MyMacro()

Dim lRow As Long
Dim lCol As Long
Dim strRow As String
Dim ws As Excel.Worksheet
Dim ts As TextStream
Dim fs As FileSystemObject

'Create the text file to write to
Set fs = New FileSystemObject
Set ts = fs.CreateTextFile("C:\Temp\test.txt", True, False)

Set ws = Application.ActiveSheet

'Loop through all the rows.
lRow = 1
Do While lRow <= ws.UsedRange.Rows.count

    'Clear the string we are building
    strRow = ""

    'Loop through all the columns for the current row.
    lCol = 1
    Do While lCol <= ws.UsedRange.Columns.count
        'Build a string to write out. 
        strRow = strRow & ws.Cells(lRow, lCol) & PadSpace(20, Len(ws.Cells(lRow, lCol)))
        lCol = lCol + 1
    Loop

    'Write the line to the text file
    ts.WriteLine strRow

    lRow = lRow + 1
    ws.Range("A" & lRow).Activate
Loop

ts.Close: Set ts = Nothing
Set fs = Nothing

End Sub

'This function will take the max number of spaces you want and the length of the string in the cell and return you the string of spaces to pad.
Public Function PadSpace(nMaxSpace As Integer, nNumSpace As Integer) As String
    If nMaxSpace < nNumSpace Then
        PadSpace = ""
    Else
        PadSpace = Space(nMaxSpace - nNumSpace)
    End If
End Function

If you only want to target certain rows and columns you can test for values as you loop. And then target columns. Something like this.

Public Sub MyMacro()

Dim lRow As Long
Dim lCol As Long
Dim strRow As String
Dim ws As Excel.Worksheet
Dim ts As TextStream
Dim fs As FileSystemObject

'Create the text file to write to
Set fs = New FileSystemObject
Set ts = fs.CreateTextFile("C:\Temp\test.txt", True, False)

Set ws = Application.ActiveSheet

'Write the header row
strRow = "User ID" & PadSpace(20, Len("User ID"))
strRow = strRow & "Total" & PadSpace(20, Len("Total"))
strRow = strRow & "Work" & PadSpace(20, Len("Work"))
ts.WriteLine strRow

'Loop through all the rows.
lRow = 1
Do While lRow <= ws.UsedRange.Rows.Count

    'Clear the string we are building
    strRow = ""

    If ws.Range("A" & lRow).Value = "User ID" Then

        'Build the string to export
        strRow = ws.Range("B" & lRow).Value & PadSpace(20, Len(ws.Range("B" & lRow).Value))
        strRow = strRow & ws.Range("F" & lRow + 2).Value & PadSpace(20, Len(ws.Range("F" & lRow + 2).Value))
        strRow = strRow & ws.Range("F" & lRow + 3).Value & PadSpace(20, Len(ws.Range("F" & lRow + 3).Value))

        'Write the line to the text file
        ts.WriteLine strRow

    End If

lRow = lRow + 1
ws.Range("A" & lRow).Activate
Loop

ts.Close: Set ts = Nothing
Set fs = Nothing

End Sub

Public Function PadSpace(nMaxSpace As Integer, nNumSpace As Integer) As String
    If nMaxSpace < nNumSpace Then
        PadSpace = ""
    Else
        PadSpace = Space(nMaxSpace - nNumSpace)
    End If
End Function

Response to user question. To run a macro on workbook open.

Private Sub Workbook_Open()
    Run "MyMacro"
End Sub

"MyMacro" is the name of the procedure in a public module Insert -> Module.

If you want to run code from a private module you cannot use "Run" command just use the procedure name.

Private Sub Workbook_Open()
    MyMacro
End Sub
查看更多
登录 后发表回答