Makro gesucht

[Markus M.]

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

[Karolus]

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

[Markus M.]

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