Macro To Excel Not Exporting Field Name

[#1]

Hi guys,

I have created a macro to export a table to excel. I can format it, eg underlining, font changes, wrap text etc but one thing I cant seem to figure out is that it does not export the field names, only the field values within the table. Is there something glaringly obvious I am missing here?

Any comments would be appreciated.

Thanks

[#2]

Hi,
Without seeing the code you are using it's not easy to say what is going awry. However, the attached is a portion of code that is definitely working for 'us':

Sub Excel_Table_Export
set s=ActiveDocument.Sheets("Intro")

set XLApp = CreateObject("Excel.Application")
set XLDOC = XLApp.Workbooks.Open ("P:\XXXXXX.xlsx")
XLApp.Visible = True

set s=ActiveDocument.Sheets("Excel Exports")
ActiveDocument.Sheets("Excel Exports").Activate
ActiveDocument.ClearCache
ActiveDocument.GetApplication.WaitForIdle
ActiveDocument.GetSheetObject("CH38").Restore
ActiveDocument.GetSheetObject("CH38").CopyTableToClipboard true
set XLSheet = XLDOC.Worksheets("P1(a)")
XLSheet.Paste XLSheet.Range("A1")

Set XLActiveCell = XLSheet.Range("A1")
XLActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Insert
Set XLActiveCell = XLSheet.Range("A2")
XLActiveCell.FormulaR1C1 = "=TRIM(R[-1]C)"
Set XLActiveCell = XLSheet.Range("B2")
XLActiveCell.FormulaR1C1 = "=TRIM(R[-1]C)"
Set XLActiveCell = XLSheet.Range("C2")
XLActiveCell.FormulaR1C1 = "=TRIM(R[-1]C)"
Set XLActiveCell = XLSheet.Range("D2")
XLActiveCell.FormulaR1C1 = "=TRIM(R[-1]C)"
Set XLActiveCell = XLSheet.Range("E2")
XLActiveCell.FormulaR1C1 = "=TRIM(R[-1]C)"

Const XLPasteValues = -4163
Const xlShiftUp = -4162

Set XLActiveCell = XLSheet.Range("A1")
Set XLSelection = XLActiveCell.Offset(1, 0).Range("A1:E1")'.Copy
XLSelection.Copy
XLSelection.PasteSpecial(XLPasteValues)
XLApp.CutCopyMode = False
XLSelection.Copy
XLSheet.Paste XLSheet.Range("A1")
Set XLRowDelete = XLActiveCell.Offset(1, 0).Range("A1:E1")
XLRowDelete.Delete(xlShiftUp)

I do the trimming as [for some reason that I've not yet worked out!] whenever the headers are pasted they have a leading space, which screws up pivots down the line. But, as I stated earlier, this code is definitely working for 'us'. Anyway, good luck!!

[suniljain]

Go To Setting-> User Preference-> Export-> Copy To Clipboard

Click "Table Box" available in the option "Include caption and Border"

[#4]

Thanks for the comments,

Sunil, unfortunately the settings change doesn't work in my case even though i am exporting a table box.

My macro is as follows:

sub ExportToXL2
Const xlShiftUp = -4162
set XLApp = CreateObject("Excel.Application")
XLApp.Visible = True
Application.Sleep(1000)

ActiveDocument.GetSheetObject("TB01").CopyTextToClipboard
XLApp.Worksheets(1).Paste()
XLApp.Worksheets(1).Range("A1:I1").Font.Bold = True
XLApp.Worksheets(1).Range("A1:I1").Font.Underline = True
XLApp.Worksheets(1).Range("A1:I1").Font.Size = 12
XLApp.Worksheets(1).Cells.WrapText = True
XLApp.Worksheets(1).Cells.ColumnWidth = 20

end sub

Can't seem to see why this won't copy field names into first row still. Is it to do with your part of the code: XLActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Insert?

Thanks

[suniljain]

set obj = ActiveDocument.GetSheetObject("CH239")
obj.ExportEx "E:\Qlikview\Prima\PPT\Department_Loadinng.xls",5
set obj = ActiveDocument.GetSheetObject("CH238")
obj.ExportEx "E:\Qlikview\Prima\PPT\Top_5_Project.xls",5
set obj = ActiveDocument.GetSheetObject("CH202")
obj.ExportEx "E:\Qlikview\Prima\PPT\0HrsProject.xls",5

[#6 · Accepted solution]

Hi,
It's nothing to do with that. That was in there as part of my trimming reqmt. I couldn't get your code to work as I got a runtime error! Anyway, I have slightly re-jigged it and included the opening of an already created file [in this case 'Book1.xlsx'] and I've just run it and it works as per:

sub ExportToXL2
set XLApp = CreateObject("Excel.Application")
set XLDOC = XLApp.Workbooks.Open ("C:\Book1.xlsx")
XLApp.Visible = True
set XLSheet = XLDOC.Worksheets("Sheet1")
Const XLPasteValues = -4163
ActiveDocument.GetSheetObject("TB01").CopyTableToClipboard true
Set XLActiveCell = XLSheet.Range("A1:I1")
XLSheet.Paste XLSheet.Range("A1")
XLApp.Worksheets(1).Range("A1:I1").Font.Bold = True
XLApp.Worksheets(1).Range("A1:I1").Font.Underline = True
XLApp.Worksheets(1).Range("A1:I1").Font.Size = 12
XLApp.Worksheets(1).Cells.WrapText = True
XLApp.Worksheets(1).Cells.ColumnWidth = 20
end sub

Hope this helps!

[#7]

Thats great, thanks for your help!