von Charly » Mi, 23.12.2009 14:04
Hallo!
Bei mir hat das mit der Nummer 108 funktioniert. Aber wie schon erwähnt, gibt es beim Nummernformat unterschiedliche Nummern, durch die es bei der Zuweisung zu Problemen kommen kann.
Ich habe mal in den Code die lange Version eingefügt, bei der das Makro den NummernformatCode selbst sucht. Wenn er kein entsprechendes Format findet, erzeugt er sich selbst einen Code. Vielleicht funktioniert es so bei dir.
Code: Alles auswählen
Sub FilterAusgabeInNeuerTabelle()
Dim Dok as Object
Dim Blatt as Object
Dim Bereich as Object
Dim Endspalte as long
Dim Endzeile as long
Dim Filterarray(0)
DIM Zielblatt as Object
Dim Zelle as Object
Dim objNummerFormat as object
Dim strNummerFormat as String
Dim lngNummerFormatId as long
Dim objLocalSettings as New com.sun.star.lang.Locale
Dok = ThisComponent
'Zielblatterstellen
If Dok.sheets.hasByName("Ergebnis") then
Dok.sheets.removeByName("Ergebnis")
end if
Dok.sheets.insertNewByName("Ergebnis",0)
Zielblatt = Dok.sheets.getByName("Ergebnis")
Ziel = Zielblatt.getCellRangeByName("A1")
'Datenbereich definieren
Blatt = Dok.getsheets().getbyName("Daten")
Cursor = Blatt.createCursor()
Cursor.gotoEndOfUSEDArea(True)
EndSpalte = Cursor.getRangeAddress().EndColumn
EndZeile = Cursor.getRangeAddress().Endrow
Bereich = Blatt.getCellRangeByPosition(0,0,Endspalte,Endzeile)
'Filterobjekt mit Einstellungen erstellen
oFilterBeschreib = Bereich.createFilterDescriptor(True)
oFilterBeschreib.ContainsHeader = false
oFilterBeschreib.UseRegularExpressions = True
oFilterBeschreib.isCaseSensitive = false
oFilterBeschreib.CopyOutputData = true
oFilterBeschreib.OutputPosition = Ziel
Filterfeld = createUnoStruct("com.sun.star.sheet.TableFilterField")
Filterfeld.operator = com.sun.star.sheet.FilterOperator.EQUAL
Filterfeld.StringValue = "[1,2,3]"
Filterfeld.field = 5
FilterArray(0) = Filterfeld
oFilterBeschreib.setFilterFields(FilterArray)
Bereich.filter(oFilterBeschreib)
'das Numberformat suchen bzw. ein neues bei nicht vorhanden erzeugen
objLocalSettings.Language = "de"
objLocalSettings.Country = "DE"
objNummerFormat = Dok.NumberFormats
strNummerFormat = "0,000"
lngNummerFormatId = objNummerFormat.queryKey(strNummerFormat,objLocalSettings, True)
If lngNummerFormatId = -1 then
lngNummerFormatId = objNummerFormat.addNew(strNummerFormat, objLocalSettings)
End if
'Ergebnisblatt bearbeiten
Cursor = ZielBlatt.createCursor()
Cursor.gotoEndOfUSEDArea(True)
EndSpalte = Cursor.getRangeAddress().EndColumn
EndZeile = Cursor.getRangeAddress().Endrow
For I = 1 to Endzeile
Zelle = Zielblatt.getCellByPosition(3,I)
Betrag = Zelle.value/100 + 4000000
Zelle.value = Betrag
Zelle.numberformat = lngNummerFormatId
Zelle = Zielblatt.getCellByPosition(4,I)
Betrag = Zelle.value/100 + 5000000
Zelle.value = Betrag
Zelle.numberformat = lngNummerFormatId
next
End Sub
Gruß
Charly
Hallo!
Bei mir hat das mit der Nummer 108 funktioniert. Aber wie schon erwähnt, gibt es beim Nummernformat unterschiedliche Nummern, durch die es bei der Zuweisung zu Problemen kommen kann.
Ich habe mal in den Code die lange Version eingefügt, bei der das Makro den NummernformatCode selbst sucht. Wenn er kein entsprechendes Format findet, erzeugt er sich selbst einen Code. Vielleicht funktioniert es so bei dir.
[code]
Sub FilterAusgabeInNeuerTabelle()
Dim Dok as Object
Dim Blatt as Object
Dim Bereich as Object
Dim Endspalte as long
Dim Endzeile as long
Dim Filterarray(0)
DIM Zielblatt as Object
Dim Zelle as Object
Dim objNummerFormat as object
Dim strNummerFormat as String
Dim lngNummerFormatId as long
Dim objLocalSettings as New com.sun.star.lang.Locale
Dok = ThisComponent
'Zielblatterstellen
If Dok.sheets.hasByName("Ergebnis") then
Dok.sheets.removeByName("Ergebnis")
end if
Dok.sheets.insertNewByName("Ergebnis",0)
Zielblatt = Dok.sheets.getByName("Ergebnis")
Ziel = Zielblatt.getCellRangeByName("A1")
'Datenbereich definieren
Blatt = Dok.getsheets().getbyName("Daten")
Cursor = Blatt.createCursor()
Cursor.gotoEndOfUSEDArea(True)
EndSpalte = Cursor.getRangeAddress().EndColumn
EndZeile = Cursor.getRangeAddress().Endrow
Bereich = Blatt.getCellRangeByPosition(0,0,Endspalte,Endzeile)
'Filterobjekt mit Einstellungen erstellen
oFilterBeschreib = Bereich.createFilterDescriptor(True)
oFilterBeschreib.ContainsHeader = false
oFilterBeschreib.UseRegularExpressions = True
oFilterBeschreib.isCaseSensitive = false
oFilterBeschreib.CopyOutputData = true
oFilterBeschreib.OutputPosition = Ziel
Filterfeld = createUnoStruct("com.sun.star.sheet.TableFilterField")
Filterfeld.operator = com.sun.star.sheet.FilterOperator.EQUAL
Filterfeld.StringValue = "[1,2,3]"
Filterfeld.field = 5
FilterArray(0) = Filterfeld
oFilterBeschreib.setFilterFields(FilterArray)
Bereich.filter(oFilterBeschreib)
'das Numberformat suchen bzw. ein neues bei nicht vorhanden erzeugen
objLocalSettings.Language = "de"
objLocalSettings.Country = "DE"
objNummerFormat = Dok.NumberFormats
strNummerFormat = "0,000"
lngNummerFormatId = objNummerFormat.queryKey(strNummerFormat,objLocalSettings, True)
If lngNummerFormatId = -1 then
lngNummerFormatId = objNummerFormat.addNew(strNummerFormat, objLocalSettings)
End if
'Ergebnisblatt bearbeiten
Cursor = ZielBlatt.createCursor()
Cursor.gotoEndOfUSEDArea(True)
EndSpalte = Cursor.getRangeAddress().EndColumn
EndZeile = Cursor.getRangeAddress().Endrow
For I = 1 to Endzeile
Zelle = Zielblatt.getCellByPosition(3,I)
Betrag = Zelle.value/100 + 4000000
Zelle.value = Betrag
Zelle.numberformat = lngNummerFormatId
Zelle = Zielblatt.getCellByPosition(4,I)
Betrag = Zelle.value/100 + 5000000
Zelle.value = Betrag
Zelle.numberformat = lngNummerFormatId
next
End Sub
[/code]
Gruß
Charly