REM ***** BASIC ***** REM Quellen: viele viele Internetseiten, besonders zu erwähnen: REM Tabellenvergleich: http://de.openoffice.info/viewtopic.php?p=28758&sid=965a5a12aaf66b3590c55a05d224c9e7#p28758 von User "kannenklaus" REM RangeSelection: https://forum.openoffice.org/en/forum/viewtopic.php?p=365582&sid=bfd72575bb8566a9fce7ef91d5c36d15#p365582 Datei von User "FJCC" REM Sortieren: Dokument "OpenOffice.org Macros Explained.odt" von http://www.pitonyak.org/oo.php von "Andrew Pitonyak", Kapitel 5.4.13 sub A_Zeilen_angleichen dim eins as string dim zwei as string dim speins as integer dim spzwei as integer dim pos as integer dim temp as string if MsgBox ("Sortiert die Tabellen automatisch jeweils nach Index-Spalte. WEITER?",1)= 2 then exit sub end if MsgBox ("Index-Spalte in erster Tabelle durch Klick auf Zelle auswählen") eins = Mache_Auswahl pos = instr(eins,":") temp = right(eins, len(eins)-pos) speins = CInt(temp) eins = left(eins, pos-1) MsgBox ("Index-Spalte in zweiter Tabelle durch Klick auf Zelle auswählen") zwei = Mache_Auswahl pos = instr(zwei,":") temp = right(zwei, len(zwei)-pos) spzwei = CInt(temp) zwei = left(zwei, pos-1) if (eins <> zwei) then Tue_Tabelle_sortieren(eins, speins) Tue_Tabelle_sortieren(Zwei, spzwei) Tue_Zeilen_angleichen(eins, zwei, speins, spzwei) else MsgBox ("Unterschiedliche Tabellenblätter im selben Dokument nötig") end if MsgBox ("FERTIG") end sub sub B_Tabellen_vergleichen dim eins as string dim zwei as string dim speins as integer dim spzwei as integer dim pos as integer dim temp as string if MsgBox ("Erste Tabelle durch Klick auf Zelle auswählen, wird Index-Spalte falls sortiert werden soll. WEITER?",1)= 2 then exit sub else eins = Mache_Auswahl pos = instr(eins,":") temp = right(eins, len(eins)-pos) speins = CInt(temp) eins = left(eins, pos-1) MsgBox ("Zweite Tabelle durch Klick auf Zelle auswählen, wird Index-Spalte falls sortiert werden soll.") zwei = Mache_Auswahl pos = instr(zwei,":") temp = right(zwei, len(zwei)-pos) spzwei = CInt(temp) zwei = left(zwei, pos-1) if (eins <> zwei) then if MsgBox ("Jeweils nach Index-Spalte sortieren? (dumm bei Leerzeilen)",1)=1 then Tue_Tabelle_sortieren(eins, speins) Tue_Tabelle_sortieren(Zwei, spzwei) end if Tue_Tabellen_vergleichen(eins, zwei) else MsgBox ("Unterschiedliche Tabellenblätter im selben Dokument nötig") end if MsgBox ("FERTIG. Markierungen sind nur in Tabelle 2.") end if end sub Sub Tue_Tabellen_Vergleichen(eins as String, zwei as String) '--Variablen für den Tabellenvergleich Dim oDoc as Object Dim oDocB as Object Dim oShFehler as Object Dim oAllSheetsA as Object Dim oAllSheetsB as Object Dim oSh1 as Object Dim oSh2 as Object Dim oCurSp1 as Object Dim oCurZe1 as Object Dim oCurSp2 as Object Dim oCurZe2 as Object Dim oCell1 as Object Dim oCell2 as Object Dim oCellDoku1 as Object Dim oCellDoku2 as Object Dim oView as Object 'für den View Dim oCellInfo as Object Dim oCellUeber as Object Dim oRange1 as Object Dim oRange2 as Object Dim oSpalte as Object 'Spaltenüberschrift der Reportabelle Dim intMaxZe as Integer Dim intMaxSp as Integer 'Zähler für die max. Zeilen- bzw. Spaltenzahl Dim intSp as Integer Dim intZe as Integer 'Zähler für Spalten- und Zeilenanfang Dim geaendert as Integer ' ### hier erzeugt er die Datei-Variable oDoc = ThisComponent oAllSheets = oDoc.Sheets oSh1 = oAllSheets.getByName(eins) oSh2 = oAllSheets.getByName(zwei) oCurSp1 = oSh1.createCursor 'Spaltenzähler für Blatt 1 oCurZe1 = oSh1.createCursor 'Zeilenzähler für Blatt 1 oCurSp2 = oSh2.createCursor 'Spaltenzähler für Blatt 2 oCurZe2 = oSh2.createCursor 'Zeilenzähler für Blatt 2 '--Cursor für das 1. Blatt erzeugen oCurSp1.gotoEndofUsedArea(true) oCurSp1.Columns.Count oCurZe1.gotoEndOfUsedArea(True) oCurZe1.Rows.Count '--Cursor für das 2. Blatt erzeugen oCurSp2.gotoEndofUsedArea(true) oCurSp2.Columns.Count oCurZe2.gotoEndOfUsedArea(True) oCurZe2.Rows.Count '--maximale Zeilenzahl ermitteln If oCurSp1.Columns.Count > oCurSp2.Columns.Count then intMaxSp = oCurSp1.Columns.Count ' msgbox(intMaxSp) Else intMaxSp = oCurSp2.Columns.Count ' msgbox(intMaxSp) End if '--maximale Zeilenenzahl ermitteln If oCurZe1.Rows.Count > oCurZe2.Rows.Count then intMaxZe = oCurZe1.Rows.Count Else intMaxZe = oCurZe2.Rows.Count End if '--Tabellenvergleich durchführen ' Zwei For/next-Schleifen, um Zellen der beiden Tabellenblätter vergleichen geaendert = 0 For intSp = 0 to intMaxSp-1 '-1, da EndofArea zur nächsten nicht benutzten Spalte geht For intZe = 0 to intMaxZe-1 '-1, da EndofUsedArea zur nächsten nicht benutzten Zeile geht oCell1 = oSh1.getCellByPosition(intSp,intZe) oCell2 = oSh2.getCellByPosition(intSp, intZe) If oCell1.String <> oCell2.String then geaendert = 1 oCell2.CellBackColor = RGB(255,255,0) End if next intZe next intSp oCell2 = oSh2.getCellByPosition(0, 0) if geaendert = 1 then oCell2.CellBackColor = RGB(255,0,0) else oCell2.CellBackColor = RGB(0,255,0) end if End Sub Sub Tue_Zeilen_angleichen(tabeins as string, tabzwei as string, idxeins as integer, idxzwei as integer) '--Variablen für den Tabellenvergleich Dim oDoc as Object Dim oDocB as Object Dim oShFehler as Object Dim oAllSheetsA as Object Dim oAllSheetsB as Object Dim oSh1 as Object Dim oSh2 as Object Dim oCurSp1 as Object Dim oCurZe1 as Object Dim oCurSp2 as Object Dim oCurZe2 as Object Dim oCell1 as Object Dim oCell2 as Object Dim oCellDoku1 as Object Dim oCellDoku2 as Object Dim oView as Object 'für den View Dim oCellInfo as Object Dim oCellUeber as Object Dim oRange1 as Object Dim oRange2 as Object Dim oSpalte as Object 'Spaltenüberschrift der Reportabelle Dim intMaxZe as Integer Dim intMaxSp as Integer 'Zähler für die max. Zeilen- bzw. Spaltenzahl Dim intSp as Integer Dim intZe as Integer 'Zähler für Spalten- und Zeilenanfang Dim geaendert as Integer Dim mastername as String Dim vergleichname as String Dim testname as String Dim vglerg as Integer oDoc = ThisComponent oAllSheets = oDoc.Sheets oSh1 = oAllSheets.getByName(tabeins) oSh2 = oAllSheets.getByName(tabzwei) oCurSp1 = oSh1.createCursor 'Spaltenzähler für Blatt 1 oCurZe1 = oSh1.createCursor 'Zeilenzähler für Blatt 1 oCurSp2 = oSh2.createCursor 'Spaltenzähler für Blatt 2 oCurZe2 = oSh2.createCursor 'Zeilenzähler für Blatt 2 '--Cursor für das 1. Blatt erzeugen oCurSp1.gotoEndofUsedArea(true) oCurSp1.Columns.Count oCurZe1.gotoEndOfUsedArea(True) oCurZe1.Rows.Count '--Cursor für das 2. Blatt erzeugen oCurSp2.gotoEndofUsedArea(true) oCurSp2.Columns.Count oCurZe2.gotoEndOfUsedArea(True) oCurZe2.Rows.Count '--maximale Zeilenzahl ermitteln If oCurSp1.Columns.Count > oCurSp2.Columns.Count then intMaxSp = oCurSp1.Columns.Count ' msgbox(intMaxSp) Else intMaxSp = oCurSp2.Columns.Count ' msgbox(intMaxSp) End if '--maximale Zeilenenzahl ermitteln If oCurZe1.Rows.Count > oCurZe2.Rows.Count then intMaxZe = oCurZe1.Rows.Count Else intMaxZe = oCurZe2.Rows.Count End if intSp = 0 intZe = 0 Do oCell1 = oSh1.getCellByPosition(idxeins,intZe) oCell2 = oSh2.getCellByPosition(idxzwei, intZe) vglerg = StrComp(oCell1.string, oCell2.string, 0) if vglerg = 1 then ' 1=Text1 ist später im Alphabet => Zeile in Tabelle1 einfügen oSh1.Rows.insertByIndex(intZe,1) elseif vglerg = -1 then ' -1=Text2 ist später im Alphabet => Zeile in Tabelle2 einfügen oSh2.Rows.insertByIndex(intZe,1) end if intZe = intZe+1 Loop Until intZe = intMaxZe End Sub Private sRangeSelection$,bRangeSelecting As Boolean function getRangeSelection() as String oController = ThisComponent.CurrentController sTitle = "Zelle auswählen, keinen Bereich" bAutoClose = True sInitial = "A1" 'Dim oDoc as Object Dim oListener as Object Dim aProps(2) As New com.sun.star.beans.PropertyValue oListener = createUnoListener("RangeSelection_","com.sun.star.sheet.XRangeSelectionListener") 'create a listener oController.addRangeSelectionListener(oListener) 'register the listener aProps(0).Name = "InitialValue" aProps(0).Value = sInitial aProps(1).Name = "Title" aProps(1).Value = sTitle aProps(2).Name = "CloseOnMouseRelease" aProps(2).Value = bAutoClose With oController.getFrame 'this is required when calling from IDE or other frame in order to avoid endless loop .activate .getContainerWindow.toFront End With bRangeSelecting = True oController.startRangeSelection(aProps()) while bRangeSelecting wait 1000 Wend oController.removeRangeSelectionListener(oListener) getRangeSelection = sRangeSelection End function Sub RangeSelection_done(oEv) sRangeSelection = oEv.RangeDescriptor bRangeSelecting = false End Sub Sub RangeSelection_aborted(oEv) sRangeSelection = "" bRangeSelecting = false End Sub Sub RangeSelection_disposing(oEv) End Sub function Mache_Auswahl() as String Dim oDoc as Object Dim RangeAsText as String Dim Tabellenname as String Dim Spalte as String Dim pos as Integer Dim oCurSp1 as Object Dim oCurZe1 as Object Dim intSp as Integer Dim Spaltennummer as Integer Dim oCell1 as Object Dim Adresse as String Dim Wiederbau as String oDoc = ThisComponent oAllSheets = oDoc.Sheets RangeAsText = getRangeSelection() 'Alles ab dem Doppelpunkt abschneiden, falls vorhanden pos = instr(RangeAsText,":") if pos <> 0 then RangeAsText = left(RangeAsText, pos-1) end if 'erstes $ abschneiden Tabellenname = right(RangeAsText, Len(RangeAsText)-1) 'Tabellenname zwischen Anfang und .$ pos = instr(Tabellenname,".$") Tabellenname = left(Tabellenname, pos-1) 'Tabellenname abschneiden und erstes $ gleich mit, vor Hochkommas weil pos dann neu belegt Spalte = right(RangeAsText, Len(RangeAsText)-pos-2) 'Eventuelle Hochkommas abschneiden pos = instr(Tabellenname,"'") Wiederbau = Tabellenname if pos <> 0 then 'Name in Hochkommas Tabellenname = mid(Tabellenname, 2, len(Tabellenname)-2) end if 'Spalte exstrahieren, also alles bis zum nächsen $ pos = instr(Spalte,"$") Spalte = left(Spalte, pos-1) Spalte = "$" & Wiederbau & ".$" & Spalte & "$1" 'MsgBox (Spalte) oSh1 = oAllSheets.getByName(Tabellenname) oCurSp1 = oSh1.createCursor 'Spaltenzähler für Blatt 1 oCurZe1 = oSh1.createCursor 'Zeilenzähler für Blatt 1 oCurSp1.gotoEndofUsedArea(true) oCurSp1.Columns.Count oCurZe1.gotoEndofUsedArea(true) intSp = 0 Do oCell1 = oSh1.getCellByPosition(intSp,0) Adresse = oCell1.AbsoluteName 'MsgBox (Adresse & "=" & Spalte) if Adresse = Spalte then Spaltennummer = intSp end if intSp = intSp+1 Loop Until intSp = oCurSp1.Columns.Count Mache_Auswahl = Tabellenname & ":" & CStr(Spaltennummer) End function sub Tue_Tabelle_sortieren(tabeins as string, idxeins as integer) rem ---------------------------------------------------------------------- rem define variables dim dDoc as Object dim oAllSheets as Object dim oSh1 as Object dim oCurSp1 as Object dim oCurZe1 as Object dim intMaxSp as Integer dim intMaxZe as Integer dim oRange Dim oSortFields(0) as new com.sun.star.util.SortField Dim oSortDesc(0) as new com.sun.star.beans.PropertyValue oDoc = ThisComponent oAllSheets = oDoc.Sheets oSh1 = oAllSheets.getByName(tabeins) oCurSp1 = oSh1.createCursor 'Spaltenzähler für Blatt 1 oCurZe1 = oSh1.createCursor 'Zeilenzähler für Blatt 1 oCurSp1.gotoEndofUsedArea(true) oCurSp1.Columns.Count intMaxSp = oCurSp1.Columns.Count oCurZe1.gotoEndOfUsedArea(True) oCurZe1.Rows.Count intMaxZe = oCurZe1.Rows.Count oRange = oSh1.getCellRangeByPosition(0,0,intMaxSp,intMaxZe) oSortFields(0).Field = idxeins oSortFields(0).SortAscending = TRUE REM Set the sort fields to use oSortDesc(0).Name = "SortFields" oSortDesc(0).Value = oSortFields() REM Now sort the range! oRange.Sort(oSortDesc()) end sub