HI Everybody
Below Iam Iam Mentioning the codes seoreately But how can i bring them together ,This is the code for Export To Excel .But I can Achieve one at a Time , But I want To get Altogether
Is there Someone to Help me with this Ima really stuck Badly .
This Code Will Export The Whole Straight Table To Excel File .
sub ExportToExcel_Divisionwise
'Dim CLApp, XLDoc,XLSheet
' set XLApp = CreateObject("Excel.Application") ' Define Object
' XLApp.Visible = True 'Visible set as true
' set XLDoc = XLApp.Workbooks.Add 'Open new workbook
' set XLSheet = XLDoc.Worksheets.Add
' ActiveDocument.GetSheetObject("CH09").CopyTableToClipboard TRUE
' XLSheet.paste
' 'SET ActiveDocument.GetSheetObject("LB13").CopyClipboard .
' 'Xlsheet.Paste XLsheet.Row (1)
'
' 'ActiveDocument.GetSheetObject("CH07").CopyTableToClipboard FALSE
' 'XLSheet.paste XLSheet.Range("A09")
' 'XLsheet.Range("A10").value="=SUM(A2:A9)"
' 'CopyQVObjectData C_QV_TABLE, "CH04", "FALSE" 'Copy data from QV object and Paste into XL
' XLSheet.Name= "BBCR CSD"
'
'end sub
'
This Code Will Export The Vlues to Excle By Region(LB17) I have Four Region I will get Four Tabs Sw,W,E,And N region
sub ExportToExcel_Divisionwise
Dim Counter
Counter = 1
Dim CLApp, XLDoc,XLSheet
set XLApp = CreateObject("Excel.Application") ' Define Object
XLApp.Visible = True 'Visible set as true
set XLDoc = XLApp.Workbooks.Add 'Open new workbook
set XLSheet = XLDoc.Worksheets.Add
Set ListBoxy = ActiveDocument.GetSheetObject("LB17") 'Name of the Branch
Set Fieldy = ListBoxy.GetField
valy = ListBoxy.GetPossibleValues
For y = LBound(valy) to UBound(valy)
Counter = 1
Fieldy.Select valy(y) 'vSelectedItemy
set XLSheet = XLDoc.Worksheets.Add
Set BranchVal = ActiveDocument.Fields("Branch").GetPossibleValues
For BranchValList = 0 To BranchVal.Count-1
msgbox BranchVal.Item(BranchValList).Text
IF(Counter = 1) then
ActiveDocument.GetSheetObject("CH09").CopyTableToClipboard TRUE
XLSheet.paste
xlSheet.Paste xlSheet.Cells(Counter, 1)
else
'Finding blank cell to paste the tables data.
Dim clm, row
clm = 1
For row = 3 To 1048576 Step 1
If(xlSheet.Cells(row,clm) = "") Then
' xlSheet.Cells(row,clm).EntireRow.Delete
Counter = row
' Msgbox(row)
exit for
End If
Next
'Copy and Paste New Product table
BranchVal.Item(BranchValList).Text.CopyTableToClipboard TRUE
xlSheet.Paste xlSheet.Cells(Counter+1, 1)
'ActiveDocument.GetSheetObject("LB01").CopyTableToClipboard TRUE
'xlSheet.Paste xlSheet.Cells(Counter, 1)
ActiveDocument.GetSheetObject("CH09").CopyTableToClipboard TRUE
xlSheet.Paste xlSheet.Cells(Counter+2, 1)
'xlSheet.Paste xlSheet.Cells(Counter, 1)
End If
'Fieldz.Select valz(z) 'vSelectedItemy
Next
' ActiveDocument.GetSheetObject("CH01").CopyTableToClipboard TRUE
' XLSheet.paste
xlSheet.name = valy(y)
Fieldy.Clear
next
Fieldy.Clear
end sub
And The This Code Will Export The Values By Branch For The Perticular Branches (LB16)
sub ExportToExcel_Divisionwise
Dim Counter
Counter = 1
Dim CLApp, XLDoc,XLSheet
set XLApp = CreateObject("Excel.Application") ' Define Object
XLApp.Visible = True 'Visible set as true
set XLDoc = XLApp.Workbooks.Add 'Open new workbook
Set ListBoxy = ActiveDocument.GetSheetObject("LB16") 'Name of the Branch
Set Fieldy = ListBoxy.GetField
valy = ListBoxy.GetPossibleValues
For y = LBound(valy) to UBound(valy)
Counter = 1
Fieldy.Select valy(y) 'vSelectedItemy
set XLSheet = XLDoc.Worksheets.Add
Set RegionVal = ActiveDocument.Fields("RegionName").GetPossibleValues
For RegionValList = 0 To RegionVal.Count-1
msgbox RegionVal.Item(RegionValList).Text
IF(Counter = 1) then
ActiveDocument.GetSheetObject("CH09").CopyTableToClipboard TRUE
XLSheet.paste
xlSheet.Paste xlSheet.Cells(Counter, 1)
else
'Finding blank cell to paste the tables data.
Dim clm, row
clm = 1
For row = 3 To 1048576 Step 1
If(xlSheet.Cells(row,clm) = "") Then
' xlSheet.Cells(row,clm).EntireRow.Delete
Counter = row
' Msgbox(row)
exit for
End If
Next
'Copy and Paste New Product table
BranchVal.Item(BranchValList).Text.CopyTableToClipboard TRUE
xlSheet.Paste xlSheet.Cells(Counter+1, 1)
'ActiveDocument.GetSheetObject("LB01").CopyTableToClipboard TRUE
'xlSheet.Paste xlSheet.Cells(Counter, 1)
ActiveDocument.GetSheetObject("CH09").CopyTableToClipboard TRUE
xlSheet.Paste xlSheet.Cells(Counter+2, 1)
'xlSheet.Paste xlSheet.Cells(Counter, 1)
End If
'Fieldz.Select valz(z) 'vSelectedItemy
Next
' ActiveDocument.GetSheetObject("CH01").CopyTableToClipboard TRUE
' XLSheet.paste
xlSheet.name = valy(y)
Fieldy.Clear
next
Fieldy.Clear
end sub
