Wer viele Tabellen entwickelt, bei denen die einzelnen Tabellenblätter gleih aufgebaut sind, kommt häufig an den Punkt an dem Änderungen an einem Tabellenblatt auf die folgenden Blätter übertragen werden müssen. Das Kopieren und anschließende Einfügen in die einzelnen Tabelenblätter ist einfach zeitraubend. Dabei hilft dieses Makro. Es kopiert den markierten Bereich auf alle restlichen rechts vom aktuellen Blatt liegenden Blätter.
REM ***** BASIC *****
sub cp2followingsheets
rem Kopiert ausgewählten Bereich auf alle folgenden Tabellenblätter
rem Objekte deklarieren
dim oDoc as Object
dim oSheets as Object
dim oCurrentSheet as Object
oDoc = thisComponent
rem Variablen deklarieren
dim i as Integer
rem Anzahl der Sheets bestimmen
oSheets = oDoc.getSheets()
rem aktuelles Sheet bestimmen
oCurrentSheet = oDoc.getCurrentController.getActiveSheet()
rem aktuellen Bereich bestimmen
oQuelleRange = oDoc.getCurrentSelection().getRangeAddress()
rem Bereich auf folgende Sheets kopieren
for i = GetPosActiveSheet(oDoc) + 1 to oSheets.getCount() - 1
oZielSheet = oDoc.Sheets.getByIndex(i)
oZielRange = oZielSheet.getCellByPosition(getColumn,getRow)
oZielCellAdresse=oZielRange.getCellAddress
oZielSheet.copyRange(oZielCellAdresse,oQuelleRange)
next
end Sub
rem ###################################################################
private Function GetPosActiveSheet(oDoc as object) as Integer
dim MyName as String
dim ListOfSheets(1)
dim i as Integer
MyName = oDoc.getCurrentController.getActiveSheet().getName()
GetNameOfAllSheets(ListOfSheets(),oDoc)
for i=0 to ubound(ListOfSheets())
if ListOfSheets(i)=MyName then GetPosActiveSheet=i
next
end Function
rem ####################################################################
private Function getRow as integer
oDoc=ThisComponent
If oDoc.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then
oCelle=oDoc.getCurrentSelection().getRangeAddress()
getRow=oCelle.StartRow
end if
end Function
rem #####################################################################
private Function getColumn as integer
oDoc=ThisComponent
if oDoc.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then
oCelle=oDoc.getCurrentSelection().getRangeAddress()
getColumn=oCelle.StartColumn
end if
end function
rem #####################################################################
private Sub GetNameOfAllSheets(NameOfSheets())
rem gibt die Namen aller Tabellenblätter in einem Array zurück
rem dim listall()
rem GetNameOfAllSheets(listall())
dim oDoc as Object
dim oSheets as Object
dim oSheet as Object
dim i as integer
dim iAnzahl as integer
oDoc = thisComponent
oSheets=odoc.sheets
Anzahl = oSheets.count
Anzahl = Anzahl - 1
redim NameOfSheets(Anzahl)
for i = 0 to Anzahl
oSheet = oDoc.Sheets(i)
NameOfSheets(i)=oSheet.name
next
end Sub
rem ######################################################################
