Makro aufzeichnen und dann ausführen geht nicht ...

[UweRammelt]

Hallo Zusammen,

aller Anfang ist schwer - besonders für Excel-Umsteiger

Ich zeichne eine Makro auf mit u.a. die Einrichtung eines "Standard-Filter" mit dem Wert "nicht leer".
Dann Zuweisung des Makros auf eine Schaltfläche.
Beim Abspielen sowohl über die Schaltfläche wie auch über "Makro ausführen" passiert jedoch nix .
Nur der letzte Befehl, nämlich Setzen des Cursors auf das erste Feld (A1), wird ausgeführt, der Rest nicht.

Mache ich da irged etwas falsch? Geht die Einrichtung eines "Standard-Filter" mit dem Wert "nicht leer" über Makrovielleicht nicht?

Beste Grüße,
Uwe

Inhalt des Makros:

Rem Attribute VBA_ModuleType=VBADocumentModule
Option VBASupport 1

sub Makrofunktion
rem ----------------------------------------------------------------------
rem define variables
dim document as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "$P$3"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())

rem ----------------------------------------------------------------------
rem dispatcher.executeDispatch(document, ".uno:DataFilterStandardFilter", "", 0, Array())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:FilterExecute", "", 0, Array())

rem ----------------------------------------------------------------------
dim args4(0) as new com.sun.star.beans.PropertyValue
args4(0).Name = "ToPoint"
args4(0).Value = "$A$1"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args4())

end sub

[turtle47]

Hi Uwe,

guckst du mal hier.

Ich habe es Dir schon mal zusammengebaut.

Code: Alles auswählen

Sub AddNewDatabaseRange()
	Dim oRange
	Dim oAddr
	Dim oSheet
	Dim oDoc
	oDoc = ThisComponent
	If NOT oDoc.DatabaseRanges.hasByName("MyRange") Then
	oSheet = odoc.getSheets().getByName("Tabelle1")
	oAddr = oSheet.getCellRangeByName("A1:A40").getRangeAddress()
	oDoc.DatabaseRanges.addNewByName("MyRange", oAddr)
	End If
	oRange = oDoc.DatabaseRanges.getByName("MyRange")
	oRange.UseFilterCriteriaSource = False 'read criteria from cells? (advanced filter)
	oRange.AutoFilter = True ' works also with False, no need to show the auto-filter controls
	oFD = oRange.getFilterDescriptor()
	oField = createUnoStruct("com.sun.star.sheet.TableFilterField")
	With oField
	.Connection = com.sun.star.sheet.FilterConnection.OR 'not important with single field
	.Field = 0 'index of the field to be filtered (0 = 1st field)
	.Operator = com.sun.star.sheet.FilterOperator.NOT_EMPTY
	'.isNumeric = False 'not important with operators EMPTY/NOT_EMPTY
	'.NumericValue = 0 'not important with operators EMPTY/NOT_EMPTY
	'.StringValue = "" 'not important with operators EMPTY/NOT_EMPTY
	End With
	oFD.setFilterFields(Array(oField))
	' not shure if we need to refresh always:
	oRange.refresh() 
End Sub

Hinweis: Wenn Du das Makro ausgführt hast und Du einen anderen Bereich filtern möchtest, dann musst Du unter
Menue > Daten > Bereich festlegen > den Bereich "MyRange" zuerst löschen!!!

Viel Erfolg.

Jürgen

[UweRammelt]

Hmm - habe mal ein paar Experimente gemacht - sooo einfach ist das alles nicht

Gelernt habe ich nun: einfach Makro aufzeichnen und fertig wie (im Excel) geht leider nicht ...

Aber der Code ist ausbaufähig und zeigt prinzipiell wie es geht - vielen Dank! Nur - dafür muss man sich Zeit nehmen

Beste Grüße,
Uwe