Makro gesucht

Antwort erstellen

BBCode ist eingeschaltet
[img] ist ausgeschaltet
[url] ist eingeschaltet
Smileys sind ausgeschaltet
Die letzten Beiträge des Themas
   

Ansicht erweitern Die letzten Beiträge des Themas: Makro gesucht

von Markus M. » Fr, 22.12.2006 19:29

Da sind wir wieder,

danke Karo für die Funktion um Leerzeilen einzufügen.

hab jetzt bis auf ein paar Kleinigkeiten das Makro mit eurer Hilfe fertiggestellt! Nochmals Vielen Dank.

Hier die aktuelle Version:

Code: Alles auswählen

Sub start
Do Until abschluss = "nie"

Do Until aColumn = 12
aCell=thisComponent.getCurrentSelection().getCellAddress()
aColumn=aCell.column
Loop
kopieren6
wait(10)

abschluss = "weiter"	
'TextCursor neu ausrichten
mysheet=thisComponent.currentcontroller.activesheet
oZelle = mysheet.getCellByPosition(0,0)
'aktuellen Cursor auf die o.a. Position setzen
 thisComponent.CurrentController.Select(oZelle)  
wait(5000)
Loop

End Sub

function einfaerben(msheet, aZeile)
oZeile = msheet.Rows(aZeile)
oZeile.CellBackColor = RGB ( 201, 227 , 204 )
end function

function fnOpenDoc(sFile)
sURL = ConvertToURL(sFile)
fnOpenDoc = StarDesktop.loadComponentFromURL(sURL, "_blank", 0, Array())
end function 

function sucheOffeneDateien(dateiname)
gesuchter_dateiname = dateiname
laenge = Len(gesuchter_dateiname)
alles = StarDesktop.getComponents()
elemente = alles.createEnumeration()
Do While elemente.HasMoreElements
   aktuell = elemente.NextElement()
   If HasUnoInterfaces( aktuell, "com.sun.star.frame.XModel" ) Then
      If aktuell.hasLocation() Then
          if Right(ConvertFromURL(aktuell.GetLocation),laenge) = gesuchter_dateiname Then
             if Right(ConvertFromURL(aktuell.GetLocation),3) ="ods" Then
                'Calc
                sucheOffeneDateien =   aktuell
                'Dokument abspeichern und schließen 
				Call aktuell.store()
				wait(10)
                aktuell.close(true)
             end if
          end if
      end if
   end if
Loop
end function 

function textInZellebereichSuchen(suchwort, dokument, herkunft)
   ' Variablen deklarieren
   Dim oZelleOderBereichOderBlatt as Object
   Dim oSuchBeschreibung as Object
   Dim oTrefferZelle as Object

  If herkunft = "von" Then
   oZelleOderBereichOderBlatt = dokument.currentcontroller.activesheet
  End If
  If herkunft = "nach" Then
   oZelleOderBereichOderBlatt = dokument.Sheets().getByName("blanko")
  End If
 ' SearchDescriptor erzeugen
   oSuchBeschreibung = oZelleOderBereichOderBlatt._
      createSearchDescriptor()
     
   ' SearchDescriptor konfigurieren
   With oSuchBeschreibung
      .SearchString = suchwort
      .SearchBackwards = False
      .SearchCaseSensitive = True
      .SearchWords = True
      .SearchRegularExpression = False
      .SearchStyles = False
      .SearchSimilarity = False
      .SearchSimilarityRelax = True
      .SearchSimilarityRemove = 2
      .SearchSimilarityAdd = 2
      .SearchSimilarityExchange = 2
   End With
   
   ' nach erster Trefferzelle suchen
   oTrefferZelle = oZelleOderBereichOderBlatt._
      findFirst( oSuchBeschreibung )
'__________
     oCelle=oTrefferzelle.getCellAddress()
      ' aktuelle Zeile, Index
         aRow=oCelle.Row
        '  aktuelle Spalte, Index
         aColumn=oCelle.column
'_____________
textInZellebereichSuchen = aColumn
 
'schliessen
'odoc.close(true)
' Wartezeit einfügen, um einen exposedexecption zu vermeiden
'wait(100)
End Function


Sub kopieren6

' Variablen deklarieren
GlobalScope.BasicLibraries.LoadLibrary("Tools") 
Dim themengebiet as Object
Dim iRun As Integer
Dim n As Integer
dim aDat() 
Dim arg() 

'nach offenen Instanzen einer bestimmten Datei suchen und Schließen
oDoc9 = sucheOffeneDateien ("Themen.ods")

'ermitteln des Speicherpfads von oDoc1 
oDoc1= thisComponent
adresse = ConvertFromUrl (oDoc1.url)
pfad = DirectoryNameOutOfPath(adresse, "\") 

'ermitteln der gerade aktiven Zeile, Spalte, Tabellenblatt und Zelle
mysheet1=oDoc1.currentcontroller.activesheet
Zellaktuell=oDoc1.getCurrentSelection().getCellAddress()
oRow=Zellaktuell.Row
oColumn=Zellaktuell.column

'Auslesen der Spalten aus oDoc1 mit den Bezeichnungen
lNummer = textInZellebereichSuchen("Nr.", oDoc1, "von")
lThemengebiet = textInZellebereichSuchen("Themengebiet", oDoc1, "von")
lDatum = textInZellebereichSuchen("Datum", oDoc1, "von")
lText = textInZellebereichSuchen("Text", oDoc1, "von")

'öffnen von oDoc2
oDoc2 = fnOpenDoc(pfad & "\Themen.ods")

'Auslesen der Spalten aus oDoc2 mit den Bezeichnungen
rNummer = textInZellebereichSuchen("Nr.",oDoc2, "nach")
rThemengebiet = textInZellebereichSuchen("Themengebiet",oDoc2, "nach")
rDatum = textInZellebereichSuchen("Datum",oDoc2, "nach")
rText = textInZellebereichSuchen("Text",oDoc2, "nach")

'Aus der der gerade aktiven Zeile in oDoc1 die Zelle auswählen mit der passenden Spaltenbezeichnung
themengebiet = mySheet1.getCellByPosition(lThemengebiet,oRow)
nummer = mySheet1.getCellByPosition(lNummer,oRow)
datum = mySheet1.getCellByPosition(lDatum,oRow)
beschreibung = mySheet1.getCellByPosition(lText,oRow)

'Ermitteln der Kopfzeilen für ein neues Tabellenblatt
bVorlage = oDoc2.Sheets().getByName("blanko")
bVZeile = bVorlage.Rows(0)

'falls Tabellenblatt mit gesuchtem Tabellennamen noch nicht existiert, wird eins erstellt und mit einer Kopftzeile versehen
If oDoc2.Sheets.hasByName(themengebiet.String)=false then 
oDoc2.Sheets.insertNewByName( themengebiet.String, 0 )
kopfZeile = oDoc2.Sheets().getByName(themengebiet.String).Rows(0)

aDat = bVZeile.getDataArray()
kopfZeile.setDataArray(aDat()) 
end if

mySheet2 = oDoc2.Sheets().getByName(themengebiet.String) 

'Schleife, welche die nächste freie Zeile in oDoc2 sucht
iRun = 0
while mySheet2.getCellByPosition(0,iRun).String <> ""
iRun = iRun + 1
wend

'die Zellen in oDoc2 ermitteln, in die der Inhalt aus oDoc1 kopiert werden soll
oBereich1 = mySheet2.getCellByPosition(rThemengebiet,iRun)
oBereich2 = mySheet2.getCellByPosition(rNummer,iRun)
oBereich3 = mySheet2.getCellByPosition(rDatum,iRun)
oBereich4 = mySheet2.getCellByPosition(rText,iRun)

'Kopieren des Inhalts
oBereich1.String = themengebiet.String
oBereich2.String = nummer.String
oBereich3.String = datum.String
oBereich4.String = beschreibung.String

'Einfügen einer Leerzeile
myrows=mySheet2.getrows
'Und jetzt einfügen: Index und Anzahl.
myrows.insertbyindex(iRun+1,1)

'Feedback für den Benutzer welche Zeile gerade kopiert wurde
'z.B. Zellhintergrund aller Zellen der gerade aktiven Zeile einfärben
einfaerben (mysheet1, oRow)

'Änderungen in oDoc2 speichern 
Call oDoc2.store()

'schliessen von oDoc2
wait(10)
oDoc2.close(true)
End Sub
Letzte Sache, die ich nicht ganz reibungslos hinbekomme:
- die start Methode läuft die ganze Zeit im Hintergrund mit, soll aber nur dann die kopieren Methode aufrufen, wenn der Benutzer mit seiner maus oder Tastatur in die 12 Spalte gelangt

Beim ersten Schleifendurchlauf funktioniert alles noch einwandfrei, beim zweiten durchlauf tritt dann schon das Problem auf, dass die Kopieren-Methode aufgerufen wird, obwohl die ausgewählte Zelle sich gar nicht mehr in der 12 Spalte befindet. :?

Was muss ich noch im Code anpassen?

Gruss

Markus

von Karolus » Fr, 22.12.2006 15:14

Hallo Markus

Code: Alles auswählen

....
myrows=mysheet.getrows
' Und jetzt einfügen: Index und Anzahl.
  myrows.insertbyindex(0,1)
......
Die erste Zahl ist der Index der Zeile die eingefügt wird(Zählung beginnt bei 0),
die zweite Zahl bestimmt die Anzahl der eingefügten Zeilen.
Du kannst für beide Werte natürlich auch Variablen eintragen.

Schau dir mal

http://www.dannenhoefer.de/faqstarbasic/
an.

gruß Karo

von Markus M. » Fr, 22.12.2006 14:46

hi Stephan,

danke für die Codevorlage, konnte es ohne Probleme in den bestehenden Code einbinden, und es funktioniert !

Habe leider bis jetzt noch nicht die passende Funktion gefunden, die mir über oder unter einer bestehenende Zeile eine Leerzeile einfügt.

Verrät mir jemand die Funktion?

Gruss

Markus

von Stephan » Fr, 22.12.2006 02:42

1. Wie ermittele ich, ob gerade ein bestimmtes Dokument geöffnet ist, welches ich nicht über das Makro geöffnet habe?
2. Wie bekomme ich dann die URL dieses geöffneten Dokumentes heraus, damit ich es abspeichern und schliessen kann?
Ist jetzt schon etwas spät (oder wahlweise etwas früh :wink: ), aber der folgende Code demonstriert das im Prinzip, Du müßtest nur das Überflüssige entfernen. Das Schließen ist aber nicht nötig, es sei denn es wäre für Deinen Code nötig. Ansonsten kannst Du direkt mit dem aus dem untenstehenden Makro rückgegebenen Dokumentobjekt weiterarbeiten.
Wenn Du das nicht allen schaffst frage nochmal, morgen (oder heute) bin ich ausgeschlafener.

Code: Alles auswählen

sub gesamt
'hier Dateinamen vorgeben
gesuchter_dateiname = "post.sxw"
'----------------------------------------
laenge = Len(gesuchter_dateiname)
alles = StarDesktop.getComponents()
elemente = alles.createEnumeration()
Do While elemente.HasMoreElements
   aktuell = elemente.NextElement()
   If HasUnoInterfaces( aktuell, "com.sun.star.frame.XModel" ) Then
      If aktuell.hasLocation() Then 
          if Right(ConvertFromURL(aktuell.GetLocation),laenge) = gesuchter_dateiname Then
             if Right(ConvertFromURL(aktuell.GetLocation),3) ="sxc" Then
                'Beispiel Calc
                blatt = aktuell.getSheets().GetByName("Tabelle1")
                zelle = blatt.getCellByPosition(0, 0)
                zelle.Value = 12345
             end if
             if Right(ConvertFromURL(aktuell.GetLocation),3) ="sxw" Then
                'Beispiel Writer
                Cursor = aktuell.Text.createTextCursor()
                Cursor.String = "Das ist ein Beispieltext"
             end if
          end if
      end if
   end if
Loop
end sub

Gruß
Stephan

von Markus M. » Fr, 22.12.2006 00:19

Abend zusammen,

so poste jetzt mal den aktuellen Code des Makros. Ist diesmal auch auskommentiert.

nochmals Danke für die Erleuchtungen, die ihr mit euren Anworten mir liefert :D

Code: Alles auswählen

function fnOpenDoc(sFile)
sURL = ConvertToURL(sFile)
fnOpenDoc = StarDesktop.loadComponentFromURL(sURL, "_blank", 0, Array())
end function 

function textInZellebereichSuchen(suchwort,dokument)
   ' Variablen deklarieren
   Dim oZelleOderBereichOderBlatt as Object
   Dim oSuchBeschreibung as Object
   Dim oTrefferZelle as Object
   
  If dokument = "oDoc1" Then
   odoc = ThisComponent
   oZelleOderBereichOderBlatt = odoc.currentcontroller.activesheet
 
   ' SearchDescriptor erzeugen
   oSuchBeschreibung = oZelleOderBereichOderBlatt._
      createSearchDescriptor()
     
   ' SearchDescriptor konfigurieren
   With oSuchBeschreibung
      .SearchString = suchwort
      .SearchBackwards = False
      .SearchCaseSensitive = True
      .SearchWords = True
      .SearchRegularExpression = False
      .SearchStyles = False
      .SearchSimilarity = False
      .SearchSimilarityRelax = True
      .SearchSimilarityRemove = 2
      .SearchSimilarityAdd = 2
      .SearchSimilarityExchange = 2
   End With
   
   ' nach erster Trefferzelle suchen
   oTrefferZelle = oZelleOderBereichOderBlatt._
      findFirst( oSuchBeschreibung )
'__________
     oCelle=oTrefferzelle.getCellAddress()
      ' aktuelle Zeile, Index
         aRow=oCelle.Row
        '  aktuelle Spalte, Index
         aColumn=oCelle.column
'_____________
textInZellebereichSuchen = aColumn
  End If

  If dokument = "oDoc2" Then
   oDoc1= thisComponent
   adr = ConvertFromUrl (oDoc1.url)
   pfad = DirectoryNameOutOfPath(adr, "\")
   odoc = fnOpenDoc(pfad & "\Themen.ods")
   oZelleOderBereichOderBlatt = odoc.Sheets().getByName("blanko")

 ' SearchDescriptor erzeugen
   oSuchBeschreibung = oZelleOderBereichOderBlatt._
      createSearchDescriptor()
     
   ' SearchDescriptor konfigurieren
   With oSuchBeschreibung
      .SearchString = suchwort
      .SearchBackwards = False
      .SearchCaseSensitive = True
      .SearchWords = True
      .SearchRegularExpression = False
      .SearchStyles = False
      .SearchSimilarity = False
      .SearchSimilarityRelax = True
      .SearchSimilarityRemove = 2
      .SearchSimilarityAdd = 2
      .SearchSimilarityExchange = 2
   End With
   
   ' nach erster Trefferzelle suchen
   oTrefferZelle = oZelleOderBereichOderBlatt._
      findFirst( oSuchBeschreibung )
'__________
     oCelle=oTrefferzelle.getCellAddress()
      ' aktuelle Zeile, Index
         aRow=oCelle.Row
        '  aktuelle Spalte, Index
         aColumn=oCelle.column
'_____________
textInZellebereichSuchen = aColumn
 
'schliessen
odoc.close(true)
' Wartezeit einfügen, um einen exposedexecption zu vermeiden
wait(100)
End If
End Function


Sub kopieren6

' Variablen deklarieren
GlobalScope.BasicLibraries.LoadLibrary("Tools") 
Dim themengebiet as Object
Dim iRun As Integer
Dim n As Integer
Dim arg() 

'ermitteln des Speicherpfads von oDoc1 
oDoc1= thisComponent
adresse = ConvertFromUrl (oDoc1.url)
pfad = DirectoryNameOutOfPath(adresse, "\") 

'ermitteln der gerade aktiven Zeile, Spalte, Tabellenblatt und Zelle
mysheet1=oDoc1.currentcontroller.activesheet
Zellaktuell=oDoc1.getCurrentSelection().getCellAddress()
oRow=Zellaktuell.Row
oColumn=Zellaktuell.column

'Auslesen der Spalten aus oDoc1 mit den Bezeichnungen
lNummer = textInZellebereichSuchen("Nr.","oDoc1")
lThemengebiet = textInZellebereichSuchen("Themengebiet","oDoc1")
lDatum = textInZellebereichSuchen("Datum","oDoc1")
lText = textInZellebereichSuchen("Text","oDoc1")

'Auslesen der Spalten aus oDoc2 mit den Bezeichnungen
rNummer = textInZellebereichSuchen("Nr.","oDoc2")
rThemengebiet = textInZellebereichSuchen("Themengebiet","oDoc2")
rDatum = textInZellebereichSuchen("Datum","oDoc2")
rText = textInZellebereichSuchen("Text","oDoc2")

'Aus der der gerade aktiven Zeile in oDoc1 die Zelle auswählen mit der passenden Spaltenbezeichnung
themengebiet = mySheet1.getCellByPosition(lThemengebiet,oRow)
nummer = mySheet1.getCellByPosition(lNummer,oRow)
datum = mySheet1.getCellByPosition(lDatum,oRow)
beschreibung = mySheet1.getCellByPosition(lText,oRow)

'öffnen von oDoc2
oDoc2 = fnOpenDoc(pfad & "\Themen.ods")

'falls Tabellenblatt mit gesuchtem Tabellennamen noch nicht existiert, wird eins erstellt
If oDoc2.Sheets.hasByName(themengebiet.String)=false then 
oDoc2.Sheets.insertNewByName( themengebiet.String, 0 )
end if

mySheet2 = oDoc2.Sheets().getByName(themengebiet.String) 

'Schleife, welche die nächste freie Zeile in oDoc2 sucht
iRun = 0
while mySheet2.getCellByPosition(0,iRun).String <> ""
iRun = iRun + 1
wend

'Kopierfunktion
'die Zellen in oDoc2 ermitteln, in die der Inhalt aus oDoc1 kopiert werden soll
oBereich1 = mySheet2.getCellByPosition(rThemengebiet,iRun)
oBereich2 = mySheet2.getCellByPosition(rNummer,iRun)
oBereich3 = mySheet2.getCellByPosition(rDatum,iRun)
oBereich4 = mySheet2.getCellByPosition(rText,iRun)

'Kopieren des Inhalts
oBereich1.String = themengebiet.String
oBereich2.String = nummer.String
oBereich3.String = datum.String
oBereich4.String = beschreibung.String



' Änderungen in oDoc2 speichern 
Call oDoc2.store()

'schliessen von oDoc2
wait(1000)
oDoc2.close(true)
End Sub
Bestimmt rümpfen jetzt einige bei der SuchFunktion mit den doppelten Code die Nase, habs aber leider anders nicht hinbekommen, ohne Syntax-Fehler zu produzieren...
Wenn jemand Ideen hat den Code zu optimieren oder zu kürzen, nur zu :wink:

Dann noch eine Sache zum dem Problem mit dem Laufzeitfehler, wenn noch eine ältere Instanz von Themen.ods geöffnet ist:
könnte man nicht eine Anweisung in den Code einbauen, die vor dem Öffnen von Themen.ods nachprüft, ob ältere Instanzen noch geöffnet sind und diese notfalls ohne nachzufragen abspeichert und schließt?

der Code zum schließen und abspeichern von Dokumenten habe ich zwar schon in das Makro eingebaut, leider weiss ich folgendes nicht:
1. Wie ermittele ich, ob gerade ein bestimmtes Dokument geöffnet ist, welches ich nicht über das Makro geöffnet habe?
2. Wie bekomme ich dann die URL dieses geöffneten Dokumentes heraus, damit ich es abspeichern und schliessen kann?

Gruss

Markus

von Karolus » Do, 21.12.2006 20:30

Hallo Markus
Die Code-zeilen 'msgBox(...'
waren doch nur zur Kontrolle

Um eine gefundene Zelladresse der Function zurückzugeben, brauchst du als 2.letzte Codezeile in der Function:

Code: Alles auswählen

....
textInZellebereichSuchen = oTrefferzelle.getCellAddress()
end function
Es wäre evtl. hilfreich wenn du mal den gesamten Makrocode posten würdest mit ein paar Erklärungen was du im Detail ereichen willst.

gruß Karo

von Toxitom » Do, 21.12.2006 20:16

Hey Markus,
...was "ist" eigentlich zellkopf, wenn ich mein Funktion ausführe?...
So, wie es jetzt darsteht - nix. Die funktion kann normalerweise einen Rückgabewert liefern, nur musst du den auch zuweisen. Da das bei dir nicht der Fall ist, ist "Zellkopf" eine undefinierte Variable ohne Inhalt.

also, korrrekt müsste es so lauten:

Code: Alles auswählen

...
zellkopf = textInZellebereichSuchen("Themengebiet")
...
function textInZellebereichSuchen(suchwort) 
....

  textInZellebereichSuchen = acolumn & "sp" & arow & "z"
end function
Jetzt wäre "zellkopf" eine Stringvariable mit dem Inhalt "6sp1z" um bei deinem Beispiel zu bleiben.

Habe dann mal zu Kontrollzwecken folgende Codezeile nach dem Funktionsaufruf eingefügt
Logisch. aColumn und aRow waren variable, die nur innerhalb der Funktion textInZellebereichSuchen definiert waren und auch nur dort sichtbar sind. Sollten sie überall sichtbar sein, so musst du sie als globale Variable vor der ersten Sub/Funcktion des Moduls definieren, also ganz am Anfang.

Wäre aber vom Programmfluss nicht schön. Nutze den Rückgabewert der Funktion!

Viele Grüße
Thomas

von Stephan » Do, 21.12.2006 20:12

eine Frage, was "ist" eigentlich zellkopf, wenn ich mein Funktion ausführe? Ein Zahlenwert? Ein Object? ...

zellkopf = textInZellebereichSuchen("Themengebiet")
das ist (allgemein) der Rückgabewert der Funktion, den Du jedoch nicht enthälst weil innerhalb der Funktion kein Ergebnis übergeben wird. Du kannst z.B. Dieses tun:

Code: Alles auswählen

function textInZellebereichSuchen(suchwort) 
'...
    oCelle=oTrefferzelle.getCellAddress() 
      ' aktuelle Zeile, Index 
         aRow=oCelle.Row 
        '  aktuelle Spalte, Index 
         aColumn=oCelle.column 
         msgbox(acolumn & "sp" & arow & "z") 
'_____________ 
textInZellebereichSuchen = oCelle
End function
dann ist zellkopf ein Objekt und es liefert:

Code: Alles auswählen

zellkopf = textInZellebereichSuchen("Themengebiet")
msgbox (zellkopf.Row & zellkopf.column)
das gewünschte Ergebnis.



Gruß
Stephan

von Markus M. » Do, 21.12.2006 18:50

Hallo Thomas,

eine Frage, was "ist" eigentlich zellkopf, wenn ich mein Funktion ausführe? Ein Zahlenwert? Ein Object? ...

Code: Alles auswählen

zellkopf = textInZellebereichSuchen("Themengebiet")
Folgendes wollte ich eigentlich mit dem Funktionsaufruf erreichen:
- zellkopf soll die Zelladresse von oTrefferZelle übernehmen

Habe mit Karos Hilfe zusätzlich noch einige Zeilen zu meiner Funktion hinzugefügt.

Code: Alles auswählen

function textInZellebereichSuchen(suchwort)
   ' Variablen deklarieren
   Dim oZelleOderBereichOderBlatt as Object
   Dim oSuchBeschreibung as Object
   Dim oTrefferZelle as Object
   'suchwort = "suchmich"
   ' Zellbereich holen in dem ersetzt werden soll
   odoc = ThisComponent
   oZelleOderBereichOderBlatt = odoc.currentcontroller.activesheet
   
   ' SearchDescriptor erzeugen
   oSuchBeschreibung = oZelleOderBereichOderBlatt._
      createSearchDescriptor()
     
   ' SearchDescriptor konfigurieren
   With oSuchBeschreibung
      .SearchString = suchwort
      .SearchBackwards = False
      .SearchCaseSensitive = True
      .SearchWords = True
      .SearchRegularExpression = False
      .SearchStyles = False
      .SearchSimilarity = False
      .SearchSimilarityRelax = True
      .SearchSimilarityRemove = 2
      .SearchSimilarityAdd = 2
      .SearchSimilarityExchange = 2
   End With
   
   ' nach erster Trefferzelle suchen
   oTrefferZelle = oZelleOderBereichOderBlatt._
      findFirst( oSuchBeschreibung )
'__________
     oCelle=oTrefferzelle.getCellAddress()
      ' aktuelle Zeile, Index
         aRow=oCelle.Row
        '  aktuelle Spalte, Index
         aColumn=oCelle.column
         msgbox(acolumn & "sp" & arow & "z") 
'_____________
End function
die Messagebox liefert mir dann z.B. folgendes: "6sp1z"

Habe dann mal zu Kontrollzwecken folgende Codezeile nach dem Funktionsaufruf eingefügt

Code: Alles auswählen

msgbox (aColumn & aRow)
aber in dem Fenster was mir dann angezeigt wird, haben aColumn & aRow keine Werte mehr!
Dabei macht es keinen Unterschied, ob ich nun die Funktion wie oben aufrufe oder so:

Code: Alles auswählen

textInZellebereichSuchen("Themengebiet")
Beide Male scheint es als ob die Werte verloren gehen!

wenn ich dann aber alternativ folgendes versuche:

Code: Alles auswählen

msgbox (zellkopf.Row & zellkopf.column)
Nur das liefert mir wieder nur einen Laufzeitfehler, weil angeblich die Objectvariable(n) zellkopf.Row & zellkopf.column nicht belegt sind????

Wie bekomme ich es hin, dass die Werte von aColumn und aRow nicht mehr verloren gehen?

Gruss

Markus

von Toxitom » Do, 21.12.2006 17:12

Hey Markus,

also, in dem Code gibt es keinen Fehler. Läuft bei mir einwandfrei :-)

Aber wenn du die Meldung bekommst, so bleibt der Compiler doch in der entsprechenden Zeile Stehen - und die ist nun markiert. So findest du doch dein "Objekt" sehr schnell :-)

Gruss
Thomas

<edit> Ahh, doch etwas: Wenn dein Suchwort nicht gefunden wird, ist natürlich dein Objekt "oTrefferZelle" nicht definiert - hier wird es eine Fehlermeldung geben, wenn du diese dann las Basis für die Spalte/Zeile nutzt. Das geht ja nicht ;-)
Musst du über eine If-Bedingung abfangen.

von Markus M. » Do, 21.12.2006 16:33

Hallo,

danke Karo, hab deinen Verbesserungsvorschlag eingebaut.

Bin gerade dabei eine SuchFunktion in den Code einzubauen, bekomme aber jedesmal beim starten des Makros und aufrufen der Suchfunktion einen Laufzeitfehler, das eine Objektvariable nicht belegt ist.

im Makro rufe ich die Funktion so auf

Code: Alles auswählen

zellkopf = textInZellebereichSuchen("Themengebiet")

Code: Alles auswählen

Function textInZellebereichSuchen (suchwort)
	' Variablen deklarieren
	Dim oZelleOderBereichOderBlatt as Object
	Dim oSuchBeschreibung as Object
	Dim oTrefferZelle as Object
	Dim findewort as String
	
	' Zellbereich holen in dem ersetzt werden soll
	oZelleOderBereichOderBlatt = thisComponent.currentcontroller.activesheet
	
	' SearchDescriptor erzeugen
	oSuchBeschreibung = oZelleOderBereichOderBlatt.createSearchDescriptor()	
		
	' SearchDescriptor konfigurieren
	With oSuchBeschreibung
		.SearchString = suchwort
		.SearchBackwards = False
		.SearchCaseSensitive = True
		.SearchWords = True
		.SearchRegularExpression = False
		.SearchStyles = False
		.SearchSimilarity = False
		.SearchSimilarityRelax = True
		.SearchSimilarityRemove = 2
		.SearchSimilarityAdd = 2
		.SearchSimilarityExchange = 2
	End With
	
	' nach erster Trefferzelle suchen
	oTrefferZelle = oZelleOderBereichOderBlatt.findFirst( oSuchBeschreibung )
		
		MsgBox "Treffer in Zelle " & oTrefferZelle.CellAddress.Column & "/" & oTrefferZelle.CellAddress.Row
		
End Function
Wer sieht den Fehler?

Gruss

Markus

von Karolus » Do, 21.12.2006 08:42

Hallo Markus
Folgendes ist mir aufgefallen:

Code: Alles auswählen

iRun = 0
n = 0
do while n <> 14
inhalt = mySheet2.getCellByPosition(0,iRun).String
If inhalt = ""  then
n = 14
Else
iRun = iRun + 1
End If
loop
wieso die Abfrage nach n<>14 ?
reicht hier nicht:

Code: Alles auswählen

 iRun = 0 
while mySheet2.getCellByPosition(0,iRun).String <> ""
iRun = iRun + 1
wend
- selbständiges erkennen in welchen Tabellenblättern von Datensaetze.ods neue Ereignisse hinzugekommen sind

Bei diesem Punkt hab ich momentan gar keine Ahnung wie ich das machen soll, deshalb hab ich es bis zum Schluss aufgehoben
Es gibt da doch eine fortlaufende Nummerierung, evtl. könntest du diese in einer Schleife abfragen, ob schon im Zieldokument vorhanden ?

Gruß Karo

von Markus M. » Do, 21.12.2006 03:01

Hallo Klaus,

danke für den Geistesblitz, genau wie ich es haben wollte :D

So damit würde ich zur mittlerweile 5 Version meines Kopier-Makros kommen.

Was hab ich diesmal neues drin im Code?
- ermitteln des gerade in Bearbeitung befindlichen Tabellenblattes und der dazugehörigen aktiven Zelle
- die aktive Zeile wird kopiert
- Es wird das jeweilige Themengebiet der gerade aktiven Zeile genommen
- Eine Schleife ist hinzugekommen, die in dem passenden Tabellenblatt von Themen.ods ermitteln soll, wo sich die nächste unbeschriebene Zeile befindet

Hier der aktuelle Code:

Code: Alles auswählen

function fnOpenDoc(sFile)
sURL = ConvertToURL(sFile)
fnOpenDoc = StarDesktop.loadComponentFromURL(sURL, "_blank", 0, Array())
end function

Code: Alles auswählen

Sub kopieren5
GlobalScope.BasicLibraries.LoadLibrary("Tools") 
Dim themengebiet as Object
Dim iRun As Integer
Dim n As Integer
 
oDoc1= thisComponent
adresse = ConvertFromUrl (oDoc1.url)
pfad = DirectoryNameOutOfPath(adresse, "\") 

mysheet1=oDoc1.currentcontroller.activesheet
Zellaktuell=oDoc1.getCurrentSelection().getCellAddress()
oRow=Zellaktuell.Row
oColumn=Zellaktuell.column

oDoc2 = fnOpenDoc(pfad & "\Themen.ods")

themengebiet = mySheet1.getCellByPosition(7,oRow)

If oDoc2.Sheets.hasByName(themengebiet.String)=false then 
oDoc2.Sheets.insertNewByName( themengebiet.String, 0 )
end if

mySheet2 = oDoc2.Sheets().getByName(themengebiet.String) 

iRun = 0
n = 0

do while n <> 14
inhalt = mySheet2.getCellByPosition(0,iRun).String
If inhalt = ""  then
n = 14
Else 
iRun = iRun + 1
End If
loop



oBereich1 = mySheet1.Rows(oRow)
aDat = oBereich1.getDataArray()
oBereich2 = mySheet2.Rows(iRun)
oBereich2.setDataArray(aDat())

End Sub
Welche Probleme traten diesmal auf?
- Wie lautet die Funktion, die eine leere Zeile nach/vor eine bestehende Zeile einfügt?

Als nächstes werde ich mich mit folgender Sache beschäftigen:
- selbständiges erkennen in welchen Tabellenblättern von Datensaetze.ods neue Ereignisse hinzugekommen sind

Bei diesem Punkt hab ich momentan gar keine Ahnung wie ich das machen soll, deshalb hab ich es bis zum Schluss aufgehoben :wink:

Ich denke mal am "einfachsten" ist es, wenn man jedesmal automatisch das Makro oder besser den Teil des Makros mit der Kopierfunktion starten lässt, sobald das aktuelle Ereignis in eine Zeile eingegeben wurde.

Also müsste man wieder eine If-Verzweisung schreiben, die "reagiert", ergo den Kopiervorgang startet, sobald der Nutzer in der aktiven Zeile z.B. an Spalte 12 ankommt.

Geht bzw. funktioniert das so, wie ich es geschildert habe oder gehts sogar noch einfacher?


Gruss

Markus

von kannenklaus » Mi, 20.12.2006 19:28

hallo markus,
eine vernüftige if-Verzweigung, dass nur noch dann ein neues Tabellenblatt angelegt werden soll, wenn es noch nicht existiert?
so müßte es klappen:

Code: Alles auswählen

If oDoc2.Sheets.hasByName("Themengebiet")=false then oDoc2.Sheets.insertNewByName( themengebiet.String, 0 )
grüße

klaus

von Markus M. » Mi, 20.12.2006 19:09

Hallo,

so hier kommt nun die vierte Version meines Kopier-Makros:
Was hab ich geändert?
- automatisches auslesen des Speicherpfads vom ersten Dokument und Übergabe der URL an die Funktion zum öffnen vom zweiten Dokument.
- kopieren von kompletten Zeilen
- Themengebiet des Ereignisses auslesen und als Argument an oDoc2.Sheets().getByName übergeben

Code: Alles auswählen

function fnOpenDoc(sFile)
sURL = ConvertToURL(sFile)
fnOpenDoc = StarDesktop.loadComponentFromURL(sURL, "_blank", 0, Array())
end function

Code: Alles auswählen

Sub kopieren4
GlobalScope.BasicLibraries.LoadLibrary("Tools") 
dim aDat()
Dim themengebiet as Object
 
oDoc1= thisComponent
adresse = ConvertFromUrl (oDoc1.url)
pfad = DirectoryNameOutOfPath(adresse, "\") 

oDoc2 = fnOpenDoc(pfad & "\Themen.ods")

mySheet1 = oDoc1.Sheets().getByName("monat")

themengebiet = mySheet1.getCellByPosition(7,2)

mySheet2 = oDoc2.Sheets().getByName(themengebiet.String)

oBereich1 = mySheet1.Rows(2)
aDat = oBereich1.getDataArray()
oBereich2 = mySheet2.Rows(2)
oBereich2.setDataArray(aDat())
End Sub
Was kommt als nächstes?
- automatisches Einfügen eines neuen Tabellenblattes in Themen.ods mit dem Themengebiet als Tabellennamen, welches noch nicht in Themen.ods existiert.

Bis jetzt läuft nämlich der Kopiervorgang nur reibungslos ab, wenn das Themengebiet als Tabellenblatt in Themen.ods schon existiert.

Die Methode um ein neues Tabellenblatt zu erzeugen lautet: oDoc2.Sheets.insertNewByName( themengebiet.String, 0 )

Aber wie verknüpfe ich das Ganze in eine vernüftige if-Verzweigung, dass nur noch dann ein neues Tabellenblatt angelegt werden soll, wenn es noch nicht existiert?

Wer hilft mir auf die Sprünge?

Gruss

Der Markus

Nach oben