Unable to change shape color using macro in LibreOffice Impress presentation mode

Question

I'm trying to use Basic macros to make a shape change its color when clicked during presentation mode. My goal is to create versatile code that works on any slide, regardless of the number of shapes.

I have a code that works (see below) when I use the "Execute interaction..." option. However, in presentation mode, clicking on the shape is possible, but it does not change the color. I've found that specific coding is needed for presentation mode to work correctly. Unfortunately, I haven't been successful in making it work.

The code that works with "Execute interaction...":

Sub ChangeColorToRed()
    Dim oDoc As Object
    Dim Page As Object
    Dim oSelection As Object
    Dim SelectedShape As Object
    
    oDoc = ThisComponent
    Page = oDoc.DrawPages(0)
    oSelection = oDoc.getCurrentSelection()
    
    If oSelection.getCount() > 0 Then
        SelectedShape = oSelection.getByIndex(0)
        
        SelectedShape.FillColor = RGB(0, 200, 0) ' Cor desejada, por exemplo, verde (0, 200, 0)
        
    End If
End Sub

I'm using LibreOffice 7.6.4.1 60 with Manjaro.

DISTRIB_ID="ManjaroLinux"
DISTRIB_RELEASE="23.1.3"
DISTRIB_CODENAME="Vulcan"
DISTRIB_DESCRIPTION="Manjaro Linux"

Answer 1

You are unnecessarily complicating the task. Instead of running a macro through Interaction, use the adjacent Animation context menu item.

Select the object for which you are going to change the color, click the Add button. In the Category field, select Emphasis: Select an emphasis effect from the list of effects. Find "Basic-Change Fill Color" in the list of Effects. Reduce the time Duration, for example to 0.01 seconds, select a suitable green color.

Run a Slide Show of your presentation and make sure everything works as intended.

By the way, it is unimaginably difficult to perform this task using a macro - the presentation don't say to the macro from which Shape it was launched. And Artificial Intelligence will not cope with such a task either.

Answer 2

I think you should remove the AI generated code as they are incorrect and doesn't contribute to the topic. You were on the right path, but unfortunately "interaction" doesn't seem to have a way to pass parameter and it seems there is no "selection" during presentation mode.

As @JohnSun mentioned, the interactive method doesn't pass any reference to the object into the code. The objects are merely "clicked" and therefore not "Selected" as you tried. Changing the URL in the Interaction screen seem promising, but unfortunately the string is not passed to the function called. Interestingly, the Hyperlink method does pass the hyperlink itself as the parameter string. The two methods seem identical, but atlas they work differently. It took me a long time, but this is the best method I came up with. You do a few additional steps. Please note that this code will only work in Presentation mode because it gets the Presentation Controller.

1. Give the shape a name
2. Add a hyperlink with text to the shape with this, where Shape2 is the name of your shape defined in step 1

vnd.sun.star.script:Standard.Module1.ChangeColorToGreen?language=Basic&location=document&p2=Shape2

3. Add this code

    Sub ChangeColorToGreen(Optional sURL$)
        Dim oDoc As Object
        Dim oPage As Object
        Dim oPages as Object
        Dim sAName$
        Dim p2 as string
        Dim oShape as Object
        Dim oCon as Object
        oDoc = ThisComponent
        p2 = getArgumentFromURL(sURL, "p2")
        
        oPresentation = oDoc.getPresentation()
        oCon = oPresentation.getController()
        iSlide = oCon.getCurrentSlideIndex()
        'MsgBox("Current slide = " &iSlide)
        oPages = oDoc.getDrawPages()
        oPage = oPages.getByIndex(iSlide)
        'MsgBox("p2= " & p2 & " got count: " & oPage.getCount())
        For i = 0 To oPage.getCount() - 1
            ' Access each shape using oShapes.getByIndex(i)
            ' For example, to print the name of each shape:
            oShape = oPage.getByIndex(i)
            sAName = oShape.getName()
            'MsgBox("Got name: " & sAName)
            If StrComp(sAName, p2) = 0 Then
                'MsgBox("Found it: " & i & "  name: " & sAName)
                Exit For
            End If
        Next i
        If oShape.SupportsService("com.sun.star.drawing.Shape") Then
            If oShape.FillColor = RGB(0, 200, 0) Then
                oShape.FillColor = -1 ' Change to white
            Else
                oShape.FillColor = RGB(0, 200, 0) ' Change to green
            End If
        End If
    
        If iSlide = oPages.getCount() -1 Then
            ' It's last page, LO doesn't refresh the page correctly, so need to end and restart the 
            ' presentation. May need to set the wait time longer to make sure there is no problem
            'MsgBox ("Last slide " & iSlide & " count " & oPages.getCount())
            oPresentation.end()
            wait(100)
            oPresentation.start()
            oCon.gotoSlide(iSlide)
        Else
            ' not last page, change to another slide and back to refresh the screen.
            oCon.gotoNextSlide()
            oCon.gotoPreviousSlide()
        End If
    End Sub
    
    Function getArgumentFromURL(sURL$,sName$) as String
        on error goto exitErr:
        Dim iStart%, i%, l%, sArgs$, a()
        iStart = instr(sURL, "?")
        l = len(sName)
        if (iStart = 0) or (l = 0) then exit function
        ' sArgs behind "?":
        sArgs = mid(sURL, iStart +1)
        a() = split(sArgs, "&")
        for i = 0 to uBound(a())
            ' not case sensitive:
            if instr(1, a(i), sName &"=", 1) = 1 then
                getArgumentFromURL = mid(a(i), l +2)
                exit for
            endif
        next
        exitErr:
            ' return ""
    End Function