🙏 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!🍀
>> 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
-
- Beiträge: 30
- Registriert: Mi 11. Mai 2011, 08:42
- Wohnort: Greifswald
Code
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
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
-
- Beiträge: 30
- Registriert: Mi 11. Mai 2011, 08:42
- Wohnort: Greifswald
Re: Code
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
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
Re: Code
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
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
-
- Beiträge: 35
- Registriert: Sa 28. Mai 2011, 15:30
Re: Code
Hallo Johanna,
Weil die Variable falsch geschrieben ist:Schnewittchen hat geschrieben: Leider funktioniert die fett markierte Stelle nicht.

FreelanceroFound = oDoc.findfirst(oseacrch) REM ersten Treffer holen
-
- Beiträge: 30
- Registriert: Mi 11. Mai 2011, 08:42
- Wohnort: Greifswald
Re: Code
Danke, das ist ja wirklich peinlich
. 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

LG, Johanna
-
- Beiträge: 30
- Registriert: Mi 11. Mai 2011, 08:42
- Wohnort: Greifswald
Re: Code
Hallo, was bedeutet: e.printStackTrace (System.out);? Ist das Base, oder welche Programmiersprache ist das?
LG, Johanna
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.