CALC: Blattschutz setzen / aufheben

[Frieder D.]

Hallo Pushkin-Sun

Mit dem Folgenden Code kannst du das erreichen.

Code: Alles auswählen

sub Test
dim oSheet as Object
Dim sPasswort as String
'die Aktive Tabelle
oSheet= ThisComponent.CurrentController.ActiveSheet
'oSheet= ThisComponent.Sheets.GetByName("Tabelle1") 'oder dit Tabelle mir Namme: "Tabelle1"
'oSheet= ThisComponent.Sheets.GetByIndex(0) 'Oder Die erste Tabelle
sPasswort="Geheim"
'Schutz aufheben
oSheet.unprotect(sPasswort)
MsgBox "Schutz ist jetzt aufgehoben."
'Tabelle Schützen
  oSheet.protect(sPasswort)
  'Rückgängigmachen Verlauf Löschen, 
  'damit man den Schutz nicht per Rückgängigmachen aufheben kann.
  ThisComponent.IsUndoEnabled =False 'Rückgängigmachen ausschalten
  ThisComponent.IsUndoEnabled =true  'Rückgängigmachen einschalten
MsgBox "Tabelle wurde geschützt"
end sub

Gruß Frieder

[Frieder D.]

Hallo,

ich habe dir mahl den gesamten Code in die API übersetzt.

di musst nur noch das Passwort, den Tabellennahme, den Zellbereich, und die Sortier-Eigenschaften anpassen.

Code: Alles auswählen

REM  *****  BASIC  *****

sub Start
dim oSheet as Object
dim oCellRange as object
Dim sPasswort as String
  sPasswort="Geheim" 'Bitte anpassen

'Zugtiff auf die Tabelle
  oSheet= ThisComponent.Sheets.GetByName("Tabelle1")
'Schutz aufheben
  oSheet.unprotect(sPasswort)
'Der Bereich A2:Gx (x = Letzte benutzte Zeile auf der Tabelle)
  oCellRange = oSheet.getCellRangeByPosition(0,1,6,GetLastUsedRow(oSheet))
  
'alternativ kann der Zellbereich auch so festgelegt werden:
  'oCellRange = oSheet.getCellRangeByName("A2:G55")
  
'Sortieren (Aufruf des Subs "SortRange" und übergabe der Variable "oCellRange")
  SortRange ( oCellRange)
'Tabelle Schützen
  oSheet.protect(sPasswort)
'Rückgängigmachen Verlauf Löschen, 
'damit man den Schutz nicht per Rückgängigmachen aufheben kann.
  ThisComponent.IsUndoEnabled =False 'Rückgängigmachen ausschalten
  ThisComponent.IsUndoEnabled =true  'Rückgängigmachen einschalten
end sub
'---------------------------------------
'Das sortiermakro:
Sub SortRange (ByVal oCellRange As Object)

    Dim SortFeld(2) As new com.sun.star.table.TableSortField
    Dim SortProps(2) As new com.sun.star.beans.PropertyValue
'hier können die Sortiereigenschaften festgelegt werden.
    SortFeld(0).Field = 1 ' Spaltennummer - Zaehlung beginnt mit Null
    SortFeld(0).IsAscending = True 'True= Aufsteigend
    SortFeld(0).IsCaseSensitive=True 'True =Groß und Kleinschreibung beachten
    SortFeld(0).FieldType = com.sun.star.util.SortFieldType.ALPHANUMERIC
    SortFeld(1).Field = 2 'Spalte 3 
    SortFeld(1).IsAscending = False 'False = Absteigend
    SortFeld(1).IsCaseSensitive=False 'false =Groß und Kleinschreibung nicht beachten
    SortFeld(1).FieldType = com.sun.star.util.SortFieldType.ALPHANUMERIC
    SortFeld(2).Field = 3 'Spalte 4
    SortFeld(2).IsAscending = True 'True= Aufsteigend
    SortFeld(2).IsCaseSensitive=False
    SortFeld(2).FieldType = com.sun.star.util.SortFieldType.ALPHANUMERIC
    
    SortProps(0).Name = "SortFields"
    SortProps(0).Value = SortFeld()
    SortProps(1).Name = "SortColumns"
    SortProps(1).Value = False 'False = Zeilen werden Sortiert.
    SortProps(2).Name = "ContainsHeader" 
    SortProps(2).Value = True ' 1. Zeile wird nicht mitsortiert.
      
    oCellRange.Sort(SortProps())
End Sub
'---------------------------------------------

'die letzte benutzte Zeile ermitteln.
Function GetLastUsedRow(oSheet as Object) As Integer 
    Dim oCell
    Dim oCursor
    Dim aAddress
    
    oCell = oSheet.getCellByPosition(0, 0)
    oCursor = oSheet.createCursorByRange(oCell)
    
    oCursor.gotoEndOfUsedArea(True)
    aAddress = oCursor.RangeAddress
    GetLastUsedRow = aAddress.EndRow
End Function

Gruß Frieder