Eport Excel

[smilingjohn]

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