🙏 Bitte helfen Sie uns das LibreOffice Forum zu erhalten. 🙏
Ihre Spende wird für die Deckung der laufenden Kosten sowie den Erhalt und Ausbau 🌱 des LibreOffice Forums verwendet.

🍀 Wir hoffen auf Ihre Unterstützung - vielen Dank!🍀

❤️ DANKE >> << DANKE ❤️

>> Dank Ihrer Unterstützung -> Keine Werbung für alle registrierten LibreOffice-Forum User! <<
🤗 Als Dankeschön werden Sie im Forum als LO-SUPPORTER gekennzeichnet. 🤗

Code

Komponentenübergreifende Themen und Hilfe zu LibreOffice
Antworten
Schnewittchen
Beiträge: 30
Registriert: Mi 11. Mai 2011, 08:42
Wohnort: Greifswald

Code

Beitrag von Schnewittchen » Di 24. Mai 2011, 10:37

Was ist an diesem Code falsch?
Welchen Dateityp könnte man statt Document oder Workbook nehmen?

Sub Import()
Dim i As Integer
Dim fFile1 As Variant, fFile2 As Variant, neuFile As Variant
Dim Datei1 As Document, Datei2 As Document, neuDatei As Document
Dim WS1 As Worksheet, WS2 As Worksheet
'On Error GoTo ErrorHandler

' Datei 1 öffnen
fFile1 = Application.GetOpenFilename("CSV-Report (*.csv), *.csv")

If fFile1 = False Then
If Workbooks.Count = 1 Then
Application.Quit
Exit Sub
Else
ThisWorkbook.Close
Exit Sub
End If
End If

Workbooks.Open FileName:=fFile1
Set Datei1 = ActiveWorkbook
Set WS1 = Datei1.Worksheets(1)
WS1.Name = "Pattern_short"

' Datei 2 öffnen
fFile2 = Application.GetOpenFilename("CSV-Report (*.csv), *.csv")

If fFile2 = False Then
MsgBox "Der Vorgang wird vorzeitig abgebrochen."
If Workbooks.Count = 2 Then
Application.Quit
Exit Sub
Else
Datei1.Close , False
ThisWorkbook.Close
Exit Sub
End If
End If

Workbooks.Open FileName:=fFile2
Set Datei2 = ActiveWorkbook
Set WS2 = Datei1.Worksheets(1)
WS2.Name = "Pattern_long"

' Speicherort/-name neue Datei abfragen
neuFile = Application.GetSaveAsFilename("Zusammenfassung.xls")
If neuFile = False Then
MsgBox "Der Vorgang wird vorzeitig abgebrochen."
If Workbooks.Count = 3 Then
Application.Quit
Exit Sub
Else
Datei1.Close , False
Datei2.Close , False
ThisWorkbook.Close
Exit Sub
End If
End If
Workbooks.Add
ActiveWorkbook.SaveAs neuFile
Set neuDatei = ActiveWorkbook

' Blätter in die neue Datei kopieren
Datei2.Worksheets(1).Copy Before:=neuDatei.Sheets(1)
Datei1.Worksheets(1).Copy Before:=neuDatei.Sheets(1)

' Datei1 und 2 schliessen
Application.DisplayAlerts = False
Datei1.Close , False
Datei2.Close , False
Application.DisplayAlerts = True

' Unnötige Blätter löschen
If neuDatei.Worksheets.Count > 2 Then
For i = Worksheets.Count To 3 Step -1
Application.DisplayAlerts = False
Worksheets(i).Delete
Application.DisplayAlerts = True
Next i
End If

' neue Datei speichern
neuDatei.Save


' Vorlagedatei schliessen
ThisWorkbook.Saved = True
ThisWorkbook.Close


'' Switch on screenupdating
'Application.ScreenUpdating = True
'Exit Sub
'
'ErrorHandler:
'MsgBox "Unexpected Error"
'Application.ScreenUpdating = True
'Application.DisplayAlerts = True
End Sub


Liebe Grüße, Johanna

Schnewittchen
Beiträge: 30
Registriert: Mi 11. Mai 2011, 08:42
Wohnort: Greifswald

Re: Code

Beitrag von Schnewittchen » Di 14. Jun 2011, 11:51

Hallo, dieses Programm habe ich mal ausprobiert. Leider funktioniert die fett markierte Stelle nicht. Könnt ihr mir da vielleicht helfen?

Liebe Grüße, Johanna
Option Explicit
Const vbYesNo As Integer = 4
Const vbYes As Integer = 6
Sub Textsuche
REM Suche Text im Dokument
Dim oDoc as Object, oCursor as Object
Dim oSearch as Object, oResult as Object
Dim oFound as Object, oFoundCursor as Object
Dim tmp as String
oDoc = thisComponent ReM hole Dokument
oCursor = oDoc.Text.createTextCursor
oSearch = oDoc.createSearchDescriptor REM Suchbegriff vom Benutzer abfragen
tmp = InputBox ("Suchtext", "Kursiv auszeichnen", "")
oSearch.searchString = tmp
oSearch.SearchregularExpression = false
oFound = oDoc.findfirst(oseacrch) REM ersten Treffer holen
While NOT isNull (ofound)
oFoundCursor = oFound.Text.createTextcursorbyrange(oFound)
oFoundCursor.CharPosture = com.sun.star.awt.FontSlant.ITALIC REM kursiv
oFound = oDoc.findnext (oFound, oSearch) REM nächster Treffer
IF NOT isNULL (ofound) Then
If MsgBox ("Weiter?", vbYesNo, "suchen") <> vbYes Then Exit Sub
End if
Wend
End sub

ixnix
Beiträge: 5
Registriert: Do 14. Apr 2011, 20:28

Re: Code

Beitrag von ixnix » Di 14. Jun 2011, 19:41

Hallo Schneewittchen

habe zwar selbst noch nichts in LO programmiert, sieht mir aber nach einem Schreibfehler aus:

oFound = oDoc.findfirst(oseacrch) REM ersten Treffer holen

da scheint ein "c" zuviel zu sein, also:

oFound = oDoc.findfirst(osearch)

Beste Grüße
ixnix
Win 7 Pro 64 bit, LO portable 4.2.5.2

Freelancer
Beiträge: 35
Registriert: Sa 28. Mai 2011, 15:30

Re: Code

Beitrag von Freelancer » Di 14. Jun 2011, 19:47

Hallo Johanna,
Schnewittchen hat geschrieben: Leider funktioniert die fett markierte Stelle nicht.
Weil die Variable falsch geschrieben ist: ;)
oFound = oDoc.findfirst(oseacrch) REM ersten Treffer holen
Freelancer

Schnewittchen
Beiträge: 30
Registriert: Mi 11. Mai 2011, 08:42
Wohnort: Greifswald

Re: Code

Beitrag von Schnewittchen » Mi 15. Jun 2011, 09:32

Danke, das ist ja wirklich peinlich :oops:. Jetzt funktioniert es. Wie kann man ein Programm schreiben, dass eine bestimmte Datei sucht und öffnet und die gewünschte Tabelle in den Text einfügt?

LG, Johanna

Schnewittchen
Beiträge: 30
Registriert: Mi 11. Mai 2011, 08:42
Wohnort: Greifswald

Re: Code

Beitrag von Schnewittchen » Mi 15. Jun 2011, 11:16

Hallo, was bedeutet: e.printStackTrace (System.out);? Ist das Base, oder welche Programmiersprache ist das?
LG, Johanna


An alle, die das LibreOffice-Forum gern nutzen und unterstützen wollen:


Bitte helfen Sie uns mit 7 Euro pro Monat.
Durch Ihren Beitrag tragen Sie dazu bei, unsere laufenden Kosten für die kommenden Monate zu decken.
Unkompliziert per Kreditkarte oder PayPal.
Als ein kleines Dankeschön werden Sie im LO-Forum als SUPPORTER gekennzeichnet.



Antworten