macro in text object

[#1]

Hi Friends,

I want to export the objects to excel, so i have written the code, when i click on test, objects are exporting to excel,

but once i pressed ok and clicking on my text object it is not working...

please suggest me that where i have to do the changes.. below is my code

sub exportToExcel_Variant3

Dim aryExport(3,3)

aryExport(0,0) = "CH09"

aryExport(0,1) = "Sales Overview"

aryExport(0,2) = "A1"

aryExport(0,3) = "data"

aryExport(1,0) = "CH10"

aryExport(1,1) = "Sales Overview"

aryExport(1,2) = "A20"

aryExport(1,3) = "data"

aryExport(2,0) = "CH11"

aryExport(2,1) = "Sales Overview"

aryExport(2,2) = "A14"

aryExport(2,3) = "data"

aryExport(3,0) = "SL01"

aryExport(3,1) = "Sales Overview"

aryExport(3,2) = "H1"

aryExport(3,3) = "data"

Dim objExcelWorkbook 'as Excel.Workbook

Set objExcelWorkbook = copyObjectsToExcelSheet(ActiveDocument, aryExport)

end sub

Private Function copyObjectsToExcelSheet(qvDoc, aryExportDefinition) 'as Excel.Workbook

Dim i 'as Integer

Dim objExcelApp 'as Excel.Application

Dim objExcelDoc 'as Excel.Workbook

Set objExcelApp = CreateObject("Excel.Application")

objExcelApp.Visible = true 'false if you want to hide Excel

objExcelApp.DisplayAlerts = false

Set objExcelDoc = objExcelApp.Workbooks.Add

Dim strSourceObject

Dim qvObjectId 'as String

Dim sheetName

Dim sheetRange

Dim pasteMode

Dim objSource

Dim objCurrentSheet

Dim objExcelSheet

for i = 0 to UBOUND(aryExportDefinition)

          qvObjectId = aryExportDefinition(i,0)

          sheetName = aryExportDefinition(i,1)

          sheetRange = aryExportDefinition(i,2)

          pasteMode = aryExportDefinition(i,3)

          Set objExcelSheet = Excel_GetSheetByName(objExcelDoc, sheetName)

          if (objExcelSheet is nothing) then

                    Set objExcelSheet = Excel_AddSheet(objExcelApp, sheetName)

                    if (objExcelSheet is nothing) then

                              msgbox("No sheet could be created, this should not occur!!!")

                    end if

          end if

    objExcelSheet.Select          

          set objSource = qvDoc.GetSheetObject(qvObjectId)

          Call objSource.GetSheet().Activate()

          'objSource.Minimize

          'qvDoc.GetApplication.WaitForIdle

          if (not objSource is nothing) then

                    if (pasteMode = "image") then

                              Call objSource.CopyBitmapToClipboard()

                    else

                              Call objSource.CopyTableToClipboard(true) '// default & fallback

                    end if

                    Set objCurrentSheet = objExcelDoc.Sheets(sheetName)

                    objExcelDoc.Sheets(sheetName).Range(sheetRange).Select

                    objExcelDoc.Sheets(sheetName).Paste

                    if (pasteMode <> "image") then

                    With objExcelApp.Selection

            .WrapText = False

            .ShrinkToFit = False

                    End With                   

                    end if      

                    objCurrentSheet.Range("A1").Select  

          end if    

next  

Call Excel_DeleteBlankSheets(objExcelDoc)

objExcelDoc.Sheets(1).Select

Set copyObjectsToExcelSheet = objExcelDoc

end function

Private Function Excel_GetSheetByName(ByRef objExcelDoc, sheetName) 'as Excel.Sheet

For Each ws In objExcelDoc.Worksheets

          If (trim(ws.Name) = Excel_GetSafeSheetName(sheetName)) then

                    Set Excel_GetSheetByName = ws

                    exit function

          End If

Next

Set Excel_GetSheetByName = nothing

End Function

Private Function Excel_GetSafeSheetName(sheetName)

          retVal = trim(left(sheetName, 31))

          Excel_GetSafeSheetName = retVal

End Function

Private Function Excel_AddSheet(objExcelApplication, sheetName) ' as Excel.Sheet

          objExcelApplication.Sheets.Add , objExcelApplication.Sheets(objExcelApplication.Sheets.Count)

          Dim objNewSheet

          Set objNewSheet = objExcelApplication.Sheets(objExcelApplication.Sheets.Count)

          objNewSheet.Name = left(sheetName,31)

          Set Excel_AddSheet = objNewSheet

End function