Hi Tobias,
first thanks for the very fast response.
The routine works with 4 tables. The two sorts run without a problem. After
table "Tabelle1", I can add three tables ("Tabelle4", "Tabelle2" and
"Tabelle3", where I want to scratch double-rows). Before I want to remove
the double-rows (after sorting "Tabelle4" and "Tabelle2"), the program
throws the exception. See the asterisks in the listing.
If you want I can send you the program as a table-file.
Thanks again.
Have a nice week.
Greetings,
Rudi
----- Original Message -----
From: "Tobias Krais" <[EMAIL PROTECTED]>
To: <dev@api.openoffice.org>
Sent: Sunday, September 14, 2008 9:48 PM
Subject: Re: [api-dev] Error exception
Hi Rudi,
I have four calc tables in one program, each has 3000 rows and 30
columns. Close to the end the routine, the system throws an error
execption. If I add a meaningless statement the routine ends one
statement before. Can somebody help me. Thanks.
please give us some code. We cannot help you without it.
Greetings, Tobias
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
Sub Main
Dim Desktop As Object
Dim Platzhalter()
Dim Url As String
Dim oTabellenDokument As Object
Dim oTabellenListe As Object
Dim Tabelle1 As Object
Dim Tabelle2 As Object
Dim Tabelle3 As Object
Dim Tabelle4 As Object
Dim EndSpalte As Integer
Dim EndZeile As Integer
Dim I As Integer
Dim Cursor As Object
Rem 4.7.3 - 290
Dim ZellenBereich As New com.sun.star.table.CellRangeAddress
Rem 4.7.3 - 293
Dim ZellenAdresse As New com.sun.star.table.CellAddress
Rem 4.7.3 - 290
ZellenBereich.Sheet = 0
ZellenBereich.StartColumn = 0
ZellenBereich.StartRow = 0
ZellenBereich.EndColumn = 30
ZellenBereich.EndRow = 3300
ZellenAdresse.Sheet = 0
ZellenAdresse.Column = 0
ZellenAdresse.Row = 0
EndSpalte = ZellenBereich.EndColumn
EndZeile = ZellenBereich.EndRow
Dim ErstV As String
Dim W_ISIN As Integer
Dim W_WKN As Integer
Dim USSymbol As String
Dim Laenge As Long
Desktop = CreateUnoService("com.sun.star.frame.Desktop")
Url = "file:///a:/AktienEuroAmSonnt.sxc"
oTabellenDokument = Desktop.loadComponentFromURL(Url, "_blank", 0,
Platzhalter())
rem oTabellenDokument = ThisComponent
oTabellenListe = oTabellenDokument.getSheets()
Tabelle1 = oTabellenListe.getByIndex(0)
ZellenBereich = ThisComponent.CurrentController.getVisibleRange()
Rem ZellenBereich = ThisComponent.CurrentController
Rem Andrew Makro Abschnitt 6.23
Dim nCurCol As Integer
Dim nCurRow As Integer
Dim aAddress As String
Rem Dim sFind As String
rem Zelle = Tabelle1.GetCellbyPosition( 0, 0 )
Cursor = Tabelle1.createCursor()
rem Cursor = Tabelle1.createCursorByRange (Zelle)
Cursor.GotoEndOfUsedArea( True)
I = Cursor.getRangeAddress().EndRow
EndZeile = I + 1
If oTabellenListe.hasByName("Tabelle2") Then
MsgBox "Tabelle2 wird gelöscht"
oTabellenListe.removeByName("Tabelle2")
Else
MsgBox "Tabelle2 ist bereits gelöscht"
EndIf
If oTabellenListe.hasByName("Tabelle4") Then
MsgBox "Tabelle4 wird gelöscht"
oTabellenListe.removeByName("Tabelle4")
Else
MsgBox "Tabelle4 ist bereits gelöscht"
EndIf
If oTabellenListe.hasByName("Tabelle1") Then
MsgBox "Tabelle2 ist nicht vorhanden"
rem Tabelle1 =
oTabellenDokument.createInstance("com.sun.star.sheet.Spreadsheet")
oTabellenListe.copyByName("Tabelle1", "Tabelle2", 1)
Else
MsgBox "Tabelle1 ist nicht vorhanden"
EndIf
If oTabellenListe.hasByName("Tabelle3") Then
oTabellenListe.removeByName("Tabelle3")
MsgBox "Tabelle3 ist vorhanden"
Else
rem Tabelle1 = oTabellenDokument.createInstance("com.sun.star.sheet.Spreadsheet")
rem oTabellenListe.insertByName("Tabelle3", Tabelle1)
MsgBox "Tabelle3 ist jetzt vorhanden"
EndIf
If oTabellenListe.hasByName("Tabelle1") Then
MsgBox "Tabelle4 ist nicht vorhanden"
Tabelle1 =
oTabellenDokument.createInstance("com.sun.star.sheet.Spreadsheet")
oTabellenListe.copyByName("Tabelle1", "Tabelle4", 1)
Else
MsgBox "Tabelle4 ist nicht vorhanden"
EndIf
rem oTabellenDokument = ThisComponent
Tabelle1 = oTabellenListe.getByName("Tabelle1")
Tabelle2 = oTabellenListe.getByName("Tabelle2")
rem Tabelle3 = oTabellenListe.getByName("Tabelle3")
Tabelle4 = oTabellenListe.getByName("Tabelle4")
Dim Entry As String
Dim Entry1 As String
Dim Entry2 As String
Dim Count As Integer
Dim Count1 As Integer
Dim Temp As String
Dim Zeile As Object
Dim Zeile1 As Object
Dim ISIN As String
Dim ISIN1 As String
Dim LByte As Variant
Dim oSheetDSC As Object
Dim oDSCRange As Object
Dim aSortFields(0) As New com.sun.star.util.SortField
Dim aSortDesc(0) As New com.sun.star.beans.PropertyValue
oSheetDSC = oTabellenliste.getByName("Tabelle4")
oDSCRange = oSheetDSC.getCellRangeByName("A1:Z2000")
aSortFields(0).Field = 2
aSortFields(0).SortAscending = TRUE
aSortDesc(0).Name = "SortFields"
aSortDesc(0).Value = aSortFields()
oDSCRange.Sort(aSortDesc())
If oTabellenListe.hasByName("Tabelle4") Then
MsgBox "Tabelle3 ist nicht vorhanden"
Tabelle4 =
oTabellenDokument.createInstance("com.sun.star.sheet.Spreadsheet")
oTabellenListe.copyByName("Tabelle4", "Tabelle3", 1)
Else
MsgBox "Tabelle3 ist vorhanden"
EndIf
**************************** I also tried the following Tabelle3 command; in this case
**************************** the error occurs before the count = 0
rem Tabelle3 = oTabellenListe.getByName("Tabelle3")
oSheetDSC = oTabellenliste.getByName("Tabelle2")
oDSCRange = oSheetDSC.getCellRangeByName("A1:Z2000")
aSortFields(0).Field = 1
aSortFields(0).SortAscending = TRUE
aSortDesc(0).Name = "SortFields"
aSortDesc(0).Value = aSortFields()
oDSCRange.Sort(aSortDesc())
rem Entry2 = Tabelle1.getCellByPosition(0, 2).String
rem Entry1 = Tabelle2.getCellByPosition(0, 2).String
rem Entry = Tabelle4.getCellByPosition(0, 2).String
**************************** after the for Count = 0 To EndZeile the errorexception occurs
For Count = 0 To EndZeile
Entry = Tabelle4.getCellByPosition(2, Count).String
Entry1 = Tabelle4.getCellByPosition(2, Count + 1).String
If Entry = Entry1 Then
ISIN = Tabelle4.getCellByPosition(12, Count).String
ISIN1 = Tabelle4.getCellByPosition(12, Count + 1).String
If ISIN = "" Then
GoTo RemoveLine
Endif
If ISIN = ISIN1 Then
GoTo RemoveLine
EndIf
PruefISIN(ISIN, ISIN1)
NextCount
Endif
RemoveLine:
rem Tabelle3.Rows.removeByName(1, 1)
rem dieser Satz wird weil doppelt vorhanden, gelöscht, indem LByte mit mit 1 gesetzt wird
LByte = Tabelle3.getCellByPosition(13, Count)
LByte.Value = 1
NextCount:
Next Count
TabelleSave
End Sub
Sub PruefISIN(ISIN, ISIN1)
Dim ISIN As String
Dim ISIN1 As String
Dim Ergebnis As String
If ISIN = ISIN1 Then
Ergebnis = ISIN
Else
Ergebnis = ISIN + ";" + ISIN1
Endif
End Sub
rem Dim oSheetDSC As Object
rem Dim oDSCRange As Object
rem Dim aSortFields(0) As New com.sun.star.util.SortField
rem Dim aSortDesc(0) As New com.sun.star.beans.PropertyValue
rem oSheetDSC = oTabellenListe.getByName("Tabelle4")
rem oDSCRange = oSheetDSC.getCellRangeByName("A1:Z2000")
rem aSortFields(0).Field = 2
rem aSortFields(0).SortAscending = TRUE
rem aSortDesc(0).Name = "SortFields"
rem aSortDesc(0).Value = aSortFields()
rem oDSCRange.Sort(aSortDesc())
Sub TabelleSave
Dim Url As String
Dim AnzahlS As Integer
Url = "file:///a:/AktienBereinigt.sxc"
Print "Anzahl Saetze: " & AnzahlS
End Sub
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
