Excel Column-Width

Я хотел бы спросить о том, как экспортировать в Excel с фиксированной шириной столбца. Поскольку ширина столбца будет зависеть от длины символа.

Вот мой пример кода: для Excel и Macro

Процедура Excel:

DEFINE VARIABLE h-excel AS COM-HANDLE NO-UNDO.
DEFINE VARIABLE h-sheet AS COM-HANDLE.
DEFINE VAR w-invname AS CHAR INITIAL "file-path\excel.xls".

CREATE "Excel.Application" h-excel.

h-sheet = h-excel:Workbooks:OPEN (w-invname,,FALSE,,,,,,,,,,FALSE) NO-ERROR.
h-excel:visible = true.

h-excel:Cells:Select.

h-excel:Run("loading"). 

/*h-excel:Range("A" + STRING(5)):VALUE = "Date Covered " + STRING(fifr) + " - " + STRING(fito).*/

h-excel:Range("A6"):Select.

RELEASE OBJECT h-sheet.
RELEASE OBJECT h-excel.

END PROCEDURE.

Макрос Excel:

Sub loading()
'
' loading Macro

'
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;file-path\text.txt", _
        Destination:=Range("A6"))
        .Name = "CarSumm"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = xlWindows
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = "|"
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .Refresh BackgroundQuery:=False
    End With
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 9
End Sub
Источник

2 ответа

'Изменить ширину столбца на основе значения заголовка len intRowsCount = ActiveSheet.UsedRange.Columns.Count Установить objCells = ActiveSheet.Cells для c = 1 В intRowsCount objCells(1, c).ColumnWidth = 1.08 * Len(objCells(1, c). Значение) Далее 'Экспортировать листы активного листа (ActiveSheet.Name). Копировать рабочие книги (2). Активировать Установить objWS = Рабочие книги (2). Рабочие листы (1) objWS.Select

'Save new worksheet with new workbookname
ActiveWorkbook.SaveAs Filename:="FilePath.xlsx" _
    , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Workbooks(2).Save
Workbooks(2).Close
Источник 
U may Try below code before exporting, U can also increase or decrease 1.08 static value if not getting desire output 

intRowsCount = ActiveSheet.UsedRange.Columns.count
Set objCells = ActiveSheet.Cells
For c = 1 To intRowsCount
  objCells(1, c).ColumnWidth = 1.08 * Len(objCells(1, c).Value)
Next
Источник
Другие вопросы по тегам