Nach Funktionsaufruf Zelle per Makro beschreiben

[Schrauber]

Ein freundliches Hallo in die Runde der Wissenden

Nach tagelangem Suchen und Forenlesen, habe ich mich entschlossen euch um Hilfe zu bitten.

Grafiktest1.ods

Hier die Datei

(169.51 KiB) 55-mal heruntergeladen

Bertiebssystem: Win 7, openOffice Version 4.1.1

Meine Calc-Datei besteht aus 2 Tabellen. Tabelle 1 beinhaltet die Benutzeransicht, Tabelle 2 die Daten.
Auf Tabelle 1 befindet sich ein über Daten/Gültigkeit erstelltes Listenfeld über dies man eine Auswahl treffen kann. Die Daten hierzu stehen in Tabelle 2.

Die Funktion ZELLINHALT_GEAENDERT(Zellname des Listenfeldes) in Tabelle 1 startet das Makro das aus Zelle F2 der Tabelle 1 den Namen der Grafik liest die aus Tabelle 2 in Tabelle 1 kopiert werden soll. Das funktioniert soweit auch gut. Nun kann dieser Vorgang ja beliebig oft wiederholt werden, wobei die neue Grafik der Alten überlagert würde (mehrere Grafiken übereinander gestapelt).
Um dies zu verhindern, muß zunächst die aktuelle Grafik gelöscht werden. Dafür steht in Zelle F1 der Tabelle 1 der Name der aktuellen Grafik.
Nachdem nun die aktuelle Grafik gelöscht ist und die neue kopiert, sollte F1 mit dem Namen der neuen Grafik besetzt werden. Dies funktioniert jedoch nur wenn das Makro per Button gestartet wird. Wird das Makro über die o.a. Funktion ausgelöst, wird F1 nicht besetzt. Könnt Ihr mir helfen eine Lösung ohne Button zu finden?

[F3K Total]

Sodele,
habe mal etwas aufgeräumt, jetzt wird die Grafik an Zelle A8 gelöscht, bevor eine andere eingefügt wird.
Statt Lesesheet und ActiveSheet habe ich jetzt immer oSheet verwendet, denn Tabelle1 ist die Tabelle mit dem Index 0 (oDoc.Sheets(0) ). Aussedem werden sAbsoluteName und oSheet an die Sub loescheGrafik übergeben, dann wird diese Sub auch etwas kürzer.

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

Gruß R

[Schrauber]

Hallo Södele,
zunächst mal herzlichen Dank! Die Zelle F1 wird zwar nicht beschrieben, aber so wie es aussieht "stapelt" oO die Grafiken nicht. Kann es sein, daß beim Kopieren in die Zelle die alte Grafik automatisch gelöscht wird? Ich möchte nur sicher sein, daß sich nicht zu viele Daten anhäufen.

Mit dankbarem Gruß
Schrauber

[F3K Total]

Genau!
Die Grafik in Zelle A8 wird gelöscht, bevor eine andere aus Tabelle 2 "rübergeholt" wird.
Anscheinend hast du gerade, als ich Version zwei hochgeladen habe, Version 1 runtergeladen.
Version 2 ist nochmal etwas verändert, die Lösch-Sub übernimmt die Zelle aus der Kopier-Sub.
Gruß R
EDIT: Ich bin nicht Södele und habe, weil du mich so genannt hast, meinen Fehler bemerkt.
Es heißt selbstverständlich
Sodele
EDIT2:

Die Zelle F1 wird zwar nicht beschrieben...

Nun, das habe ich weggelassen, da es nicht nötig ist die "alte" Grafik aufzuschreiben, sie wird ja anhand der Zelle, in der sie steht, gefunden.

[Schrauber]

Vielen Dank Sodele!
Es funktioniert super. Doch nun noch eine abschließende Frage: Ist das Beschreiben von F1 in diesm Fall per Makro nicht möglich?

Gruß
Schrauber

[F3K Total]

Ach so,
klar ist das normalerweise möglich, will mir aber mit ApacheOpenOffice auch nicht gelingen.
Komischerweise geht es mit LibreOffice problemlos:

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  ...
.
.
.

scheint ein Bug zu sein ...
Klick doch mal auf das Sodele
Gruß R

[Schrauber]

Nochmal vielen Dank, auch für den aufklärenden Link.

Gruß
Schrauber