OpenOffice.info

Code: Alles auswählen

Sub copyGrafikEleminZelle
    DIM bGrafik_war_da as Boolean
    DIM sGrafName as String
    oDoc = ThisComponent
    oSheet = oDoc.Sheets(0)   rem Sheet aus dem der Grafkname gelesen wird
    oSchreibeCell = oSheet.getCellRangeByName("F1") rem Zelle in die der aktuelle Grafikname kopiert wird
    oleseCell = oSheet.getCellRangeByName("F2") rem Zelle aus der der Grafkname gelesen wird
    sGrafName = oleseCell.string
    oSchreibeCell.string = sGrafName 'hier wird bei LibreOffice ordentlich geschrieben, AOO unter Windows 7 will bei mir nicht  ...
.
.
.

Code: Alles auswählen

Function zellinhalt_geaendert(x)
    copyGrafikEleminZelle
end function

Sub copyGrafikEleminZelle
    DIM bGrafik_war_da as Boolean
    oDoc = ThisComponent
    oSheet = oDoc.Sheets(0)   rem Sheet aus dem der Grafkname gelesen wird
    oleseCell = oSheet.getCellRangeByName("F1") rem Zelle aus der der Grafkname gelesen wird
    sGrafName = oleseCell.string
    oleseSheetGr = oDoc.Sheets(1)   rem Sheet aus dem der Grafkname gelesen wird
    oCell = oSheet.getCellRangeByName("A8") rem Zelle in die die Grafik Kopiert wird
    sAbsoluteName = oCell.AbsoluteName'Absoluter Name der Zelle, z.B. "$Tabelle1.$A$8"
    loescheGrafik(sAbsoluteName,osheet)
    For n = 0 to oleseSheetGr.DrawPage.getCount -1
        oShape = oleseSheetGr.DrawPage.getByIndex(n)
        If oShape.supportsService("com.sun.star.drawing.Shape") Then
            If oShape.Name = sGrafName Then
                oshapecoppy = thiscomponent.createInstance("com.sun.star.drawing.GraphicObjectShape")
                bGrafik_war_da = True  rem merken daß die Grafik gefunden wurde
                with oshapecoppy
                    .name = oShape.Name
                    .size = oShape.size     
                    .position = oCell.position   
                    .GraphicURL = oShape.GraphicURL
                end with
                oSheet.Drawpage.add(oshapecoppy)
                exit for   rem Schleife verlassen
            End If
        End If
    Next n
    if not bGrafik_war_da Then 
               msgbox "Die entsprechende Grafik ist nicht vorhanden" 
    end if    
End Sub

Sub loescheGrafik(sAbsoluteName,oSheet)  rem löscht eine Grafik auf sheet 0
   For n = 0 to oSheet.DrawPage.getCount -1
       oShape = oSheet.DrawPage.getByIndex(n)
       If oShape.supportsService("com.sun.star.drawing.Shape") Then
           if oShape.Anchor.AbsoluteName = sAbsoluteName then 'die Grafik die an Zelle A8 hängt wird gelöscht
               oSheet.DrawPage.remove(oShape)
               Exit For rem Schleife verlassen
           end if         
       End If
   Next n
End Sub