macro

[#1]

Hi Friends,

i have created macro to export the multiple objects to excel,

when i will click on the test, objects are exporting to excel, but when i give OK and clicking on the text object it is not working.

i have to give any condition to text object to run macro?

what might be the problem? if any one knows please help me. here is my code for Macro...

sub exportToExcel_Variant3

Dim aryExport(4,3)

aryExport(0,0) = "CH20"

aryExport(0,1) = "Breakdown"

aryExport(0,2) = "A1"

aryExport(0,3) = "data"

aryExport(1,0) = "CH21"

aryExport(1,1) = "Breakdown"

aryExport(1,2) = "A20"

aryExport(1,3) = "data"

'aryExport(2,0) = "CH06"

'aryExport(2,1) = "Breakdown"

'aryExport(2,2) = "E1"

'aryExport(2,3) = "data"

'aryExport(3,0) = "CH50"

'aryExport(3,1) = "Sales Overview"

'aryExport(3,2) = "H1"

'aryExport(3,3) = "image"

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

Private Sub Excel_DeleteBlankSheets(ByRef objExcelDoc)

For Each ws In objExcelDoc.Worksheets

          If (not HasOtherObjects(ws)) then

                    If objExcelDoc.Application.WorksheetFunction.CountA(ws.Cells) = 0 Then

                              On Error Resume Next

                              Call ws.Delete()

                    End If

          End If

Next

End Sub

Public Function HasOtherObjects(ByRef objSheet) 'As Boolean

    Dim c

    If (objSheet.ChartObjects.Count > 0) Then

              HasOtherObjects = true

              Exit function

    End If

    If (objSheet.Pictures.Count > 0) Then

              HasOtherObjects = true

              Exit function

    End If

    If (objSheet.Shapes.Count > 0) Then

              HasOtherObjects = true

              Exit function

    End If

    HasOtherObjects = false

End Function

[gautik92]

Have a look at this

[vikasmahajan]

check with this settings

Vikas

[#4]

Hi Vikas,

settings are same...

[#5]

how many objects we can export to a single excel sheet using macro?

[marcus_sommer]

If it's worked from inside the module per clicking on Test and nothing happens if you try to execute it per button from the GUI it meant that the button isn't configured properly (maybe a typo by the macroname).

- Marcus

[#7]

Dear Macrus , Thank you for the clarification,

Do i have to mention the button obj id anywhere in the script? if yes please let me know where i have to give the ID

Warm Regards,

Sowmya

[marcus_sommer]

The object-id from the button isn't important - the button only needs an action from the area extern and there you choose "execute macros" and need to get the correct macro-name.

- Marcus

[#9]

Macrus,

Thank you for the reply. but still it is not working.

can you please gone through my code once ... is there any changes i have to do?

[marcus_sommer]

If I understand you right that the macro worked from the macro-module then the macro itself is ok. If it's not worked from the gui per clicking on a button could it be that you tried to execute the macro within the webview or per access point and AJAX client which couldn't execute most of macros (and definitely not this one). Per IE plugin should it be possible if the macro-execution is enabled and it's not blocked from any security-measures and if excel is installed.

- Marcus