Makieren und Löschen mit Makro

[tsw68]

Wunderschönen !

Ich beschäftige mich schon seit Stunden mit Makro Aufzeichnen .
Es möchte einfach nicht funktionieren.

Zelle E,F,H,J,L,N,P,R,T,V,X,Z,AB von 4-12 makieren und löschen, und das auf 34 Tabellen.

Makro löscht immer nur die ersten makierten zellen.

Ich muss noch sagen , Ich verstehe nicht so viel von Makros deshalb habe ich es mit Makro Aufzeichnen versucht.

Was muß ich machen um mein Problem zu beheben ?

MFG

[clag]

Moin tsw68,

aufgezeichnete Makros können bisher nicht mit Mehrfachmarkierungen umgehen!

Dafür müsste man ein Makro von Hand schreiben, allerdings sind deine Angaben dazu etwas zu dürre.
Die 34 Tabellenblätter sind sämtliche oder nur eine Auswahl von noch mehr Tabellenblättern,
wenn ja sind die Namen bzw der Index der Blätter nötig.

Eine möglicherweise andere brauchbare Idee wäre,
du erstellst aus dem gesamten Dokument ohne Daten in den genannten Zellen eine Vorlage,
aus dieser kannst du dann bei Bedarf auf Mausklick ein neues leeres Dokument erstellen.

[Stephan]

clag hat eigentlich alles gesagt.

Wenn Du genaue Angaben machst, welche Tabellen und Zelle gelöscht werden sollen und wohin dabei die anderen Zellen verschoben werden sollen, wird Dir wohl jemand schnell so ein Makro zusammenschreiben.

Wenn Du es selbst tun willst müsstest Du notfalls für eine einzelne Zelle aufzeichnen:

Code: Alles auswählen

sub Main4
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "$G$5"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())

rem ----------------------------------------------------------------------
dim args2(0) as new com.sun.star.beans.PropertyValue
args2(0).Name = "Flags"
args2(0).Value = "U"

dispatcher.executeDispatch(document, ".uno:DeleteCell", "", 0, args2())

end Sub

und dann händisch ergänzen, z.B. so:

Code: Alles auswählen

sub Main4
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"

dim args2(0) as new com.sun.star.beans.PropertyValue
args2(0).Name = "Flags"
args2(0).Value = "U"

'alle Zellen:
zellen = Array("$E$4", "$F$4", "$H$4" )

for i = 0 To UBOUND(zellen())

args1(0).Value = zellen(i)
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())

rem ----------------------------------------------------------------------

dispatcher.executeDispatch(document, ".uno:DeleteCell", "", 0, args2())
Next i

end Sub

für viele Zelle ist der Code so aber ineffizient, es wäre bessser das gleich komplett per Hand zu programmieren.


Gruß
Stephan

[tsw68]

Hi !

Tabelle_Forum.ods

(26.11 KiB) 172-mal heruntergeladen

Hier eine Tabelle von 34
Meine Tabellen haben denn Namen -
1 Spieltag / 2 Spieltag 3 Spieltag usw. bis 34

Im anhang sind alle Zellen die ich löschen möchte Grün hinterlegt
Ach so, Ich möchte mir einen Button erstellen zum Löschen.

Ich hoffe das versteht ihr jetzt.

Vielen Dank !

MFG

[Stephan]

Ich hoffe das versteht ihr jetzt.

vor allem erahne ich das Du garkeine Zellen löschen willst, sondern Zellinhalte. Ist das so? Oder willst Du doch Zellen löschen?


Zum Löschen von Zellen hatte ich inzwischen folgendes Rahmenwerk entworfen:

Code: Alles auswählen

Sub loeschen()
  'Spalten
  spalten = Array("E","F","H","J","L","N","P","R","T","V","X","Z","AB")
  'über Tabellenindex
  For i = 0 To 1 '33
    akt_tabelle = ThisComponent.Sheets().getByIndex(i)
    'Zellen...4 bis ...12
    For j = 0 To 12
      For k = 4 to 12
        akt_zelle = akt_tabelle.getCellRangeByName(spalten(j) & k)
        zelle_loeschen(akt_tabelle, akt_zelle, "up")
      Next k
    Next j
  Next i  
End Sub


Function zelle_loeschen(tabelle As Object, zellobjekt As Object, modus As String)
  Select Case modus
    Case "up"
      tabelle.removeRange(zellobjekt.getRangeAddress, com.sun.star.sheet.CellDeleteMode.UP)
    Case "left"
      tabelle.removeRange(zellobjekt.getRangeAddress, com.sun.star.sheet.CellDeleteMode.LEFT)
    Case "rows"
      tabelle.removeRange(zellobjekt.getRangeAddress, com.sun.star.sheet.CellDeleteMode.ROWS)
    Case "columns"
      tabelle.removeRange(zellobjekt.getRangeAddress, com.sun.star.sheet.CellDeleteMode.COLUMNS)
  End Select
End Function

Gruß
Stephan

[tsw68]

natürlich den Zelleninhalt.
Habe mich mal wider falsch ausgedrückt.

[clag]

Hallo tsw68,

habe hier mal ein Makro erstellt das deinen Wunsch erfüllen sollte.
um nicht jeden Tabellennamen extra zu prüfen zu müssen, werden alle Tabellenblätter die mit "## Spieltag" benannt sind bearbeitet.
Also falls ein "35. Spieltag" besteht werden dort auch die Strings entfernt.

Code: Alles auswählen

Sub clearresults
  oCalc = ThisComponent
  oCalc.lockControllers()
  oCalc.addActionLock()
  aRanges = Array("E4:E12","F4:F12","H4:H12","J4:J12","L4:L12","N4:N12",_
  "P4:P12","R4:R12","T4:T12","V4:V12","X4:X12","Z4:Z12","AB4:AB12")
    for ix=1 to oCalc.Sheets.Count
      sName = ix &" Spieltag"
      if oCalc.Sheets.hasbyName(sName) then 
      oSheet = oCalc.Sheets.getbyName(sName)
        for iy=0 to uBound(aRanges())
          oCellRange = osheet.getCellRangeByName(aRanges(iy))
          oCellRange.clearContents(com.sun.star.sheet.CellFlags.STRING)
        next
      end if
    next
  oCalc.removeActionLock()
  oCalc.unlockControllers()
  msgbox "färtich"
End Sub

[tsw68]

Hallo clag
Mal wider Super gut ! genau so .

Damit ist mal wider ein Problem gelöst.

Danke an alle!

MFG tsw68