3

我有一个从其他程序导出的 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
4

1 回答 1

1

呼..，这花费了一些时间和试验，这里是 Office 2012 的工作解决方案

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

如果您已经有了目标 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
于 2012-06-22T20:46:39.983 回答