Editing an Excel report in Visio

[HansNL]

I'm quite new to VBA and trying to change a generated report.
Here's the code I have so far (partly achieved from recorded macro):

Code Select Expand

Private Sub CommandButton1_Click()

'Execute report and publice like a visio shape
Visio.Application.Addons("VisRpt").Run ("/rptDefName=Bronontwerp.vrd/rptOutput=EXCEL_SHAPE")

'change shape's pin position to left bottom and set location to x=10m and y=10m
'THIS code is recorded:

'Enable diagram services
    Dim DiagramServices As Integer
    DiagramServices = ActiveDocument.DiagramServicesEnabled
    ActiveDocument.DiagramServicesEnabled = visServiceVersion140
   
    Dim UndoScopeID1 As Long
    UndoScopeID1 = Application.BeginUndoScope("Grootte en positie 2D")
    Application.ActiveWindow.Page.Shapes.ItemFromID(50).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU = "54.996175 m"
    Application.ActiveWindow.Page.Shapes.ItemFromID(50).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU = "7.94385 m"
    Application.ActiveWindow.Page.Shapes.ItemFromID(50).CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinX).FormulaU = "Width*0"
    Application.ActiveWindow.Page.Shapes.ItemFromID(50).CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinY).FormulaU = "Height*0"
    Application.EndUndoScope UndoScopeID1, True

    Dim UndoScopeID2 As Long
    UndoScopeID2 = Application.BeginUndoScope("Grootte en positie 2D")
    Application.ActiveWindow.Page.Shapes.ItemFromID(50).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU = "10 m"
    Application.EndUndoScope UndoScopeID2, True

    Dim UndoScopeID3 As Long
    UndoScopeID3 = Application.BeginUndoScope("Grootte en positie 2D")
    Application.ActiveWindow.Page.Shapes.ItemFromID(50).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU = "10 m"
    Application.EndUndoScope UndoScopeID3, True

    'Restore diagram services
    ActiveDocument.DiagramServicesEnabled = DiagramServices
   
End Sub

The recorded code works only when I have the right ID of the just generated report. I need a way to get the ID of the new shape instead of this fixed ID number.

Next on the whishlist is to change the layout of the Excel plugin shape:
- change fonts, fill colors and text alignment
- remove top title bar

Now it looks like the attached image.

[Yacine]

Hi Hans,

the newly created report is the last shape of the shapes collection.

Code Select Expand

Sub lastShape()
Dim shp As Shape
    Set shp = ActivePage.Shapes(ActivePage.Shapes.Count)
    Debug.Print shp.ID; shp.Name
End Sub

Accessing and modifying an embedded report can be done like this:

Code Select Expand

Sub formatXL()
    On Error GoTo errFormatXL
    Dim objXL As Object
    Dim OLEo As OLEObject
    Dim rng As Object
   
   
    For Each OLEo In ActiveDocument.OLEObjects
        If Left(OLEo.ProgID, 5) = "Excel" Then
            Set objXL = OLEo.Object
            With objXL.Sheets(1)
                Set rng = .usedrange
                With rng.Interior
                    .PatternColorIndex = xlAutomatic
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
                End With
                For i = 5 To 6
                    rng.borders(i).LineStyle = xlNothing
                Next i
                For i = 7 To 12
                    .LineStyle = 1
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = 2
                Next i

                .Rows("1:1").Select
                .Selection.Delete Shift:=xlUp
                .Selection.Font.Bold = True

            End With
            Set objXL = Nothing
        End If
    Next OLEo
errFormatXL:
    Debug.Print Err.Description
    Set objXL = Nothing
    Set OLEo = Nothing
End Sub


HTH,
Y.

[HansNL]

Thanks a lot Yacine,

Now I have the location and pinposition thing working.

However when I run the modifying part I get this: error 91 object variable or with block variable not set

I'm not really experienced with VB and don't know which variable is not set and how to fix it.

[Yacine]

To debug a VB code I suggest to run the code step by step so as to get the faulty line.
I inserted an error handling because of the objects created, that I want to reset. But removing the error handling would point faster to the line causing the problem.