Транспонирование Excel через vbscript

Question

У меня есть таблица Excel, которую я экспортировал из какой-либо другой программы.

У этого есть строки, которые окрашены в зависимости от нескольких условий ведения бизнеса.

Теперь мне нужно перенести весь лист Excel вместе с цветами и форматированием.

Обратите внимание, что я должен сделать это, используя только Vbscript.

Это код, который я написал до сих пор, но это переставляет без форматирования:

sub transpose 
On Error Resume Next 
Set objExcel = CreateObject("Excel.Application") 
objExcel.Visible = False 
objExcel.Workbooks.Add() 
set table = ActiveDocument.GetSheetObject("CH01") 
CellRect = ActiveDocument.GetApplication().GetEmptyRect() 
CellRect.Top = 0 
CellRect.Left = 0 
CellRect.Width = table.GetColumnCount 
CellRect.Height = table.GetRowCount 
set CellMatrix = table.GetCells(CellRect) 
for RowIter=CellRect.Top to CellRect.Width-1 
    for ColIter=CellRect.Left to CellRect.Height-1 
    ObjExcel.Cells(RowIter+1, ColIter+1).Value = CellMatrix(ColIter)(RowIter).Text 
    'msgbox(CellMatrix(ColIter)(RowIter).Text) 
    next 
next 
objExcel.ActiveWorkbook.SaveAs("C:\Documents and Settings\prasanna\Desktop\test3.xls") 
objExcel.Application.Workbooks.Open("C:\Documents and   Settings\prasanna\Desktop\test3.xls") 
objExcel.Application.Visible = True 
objExcel = Nothing 
end sub 

Answer 1

Уф .., это стоило некоторое время и экспериментировать, здесь рабочее решение для офиса 2012

const xlPasteValuesAndNumberFormats = 12 'doesn't work with Excel 2010 ? 
const xlFormats =-4122 
Set objExcel = CreateObject("Excel.Application") 
objExcel.Visible = True 
objExcel.DisplayAlerts = false 

если вы Allready у вашей целевой XLS вы можете пропустить эти строки

Set wbkDest = objExcel.Workbooks.Add 
wbkDest.saveAs "c:\test2.xls" 
wbkDest.close 

и далее здесь

Set objWorkbook1= objExcel.Workbooks.Open("C:\test1.xls") 
Set objWorkbook2= objExcel.Workbooks.Open("C:\test2.xls") 
objWorkbook1.Worksheets("Sheet1").UsedRange.Copy 
'we have to do the paste twice, once for the values, once for the formats 
objWorkbook2.Worksheets("Sheet1").Range("A1").PasteSpecial xlPasteValuesAndNumberFormats 
objWorkbook2.Worksheets("Sheet1").Range("A1").PasteSpecial xlFormats 
objWorkbook1.save 
objWorkbook2.save 
objWorkbook1.close 
objWorkbook2.close 
set objExcel=nothing