Das Notes Forum

Domino 9 und frühere Versionen => Entwicklung => Thema gestartet von: LisaS am 19.02.03 - 11:40:02

Titel: Excel-Export Script
Beitrag von: LisaS am 19.02.03 - 11:40:02: Hallo,
ich habe folgendes Script fï¿½r den Export nach Excel.
Das Rich-Text-Feld Beitrag soll ins Excel ohne Zeilenumbï¿½che exportiert werden. Die Returns habe ich schon duch Blanks ersetzt. Was muï¿½ ich an der marierten Stelle einfï¿½gen?
Please Help!!

Sub Click(Source As Button)
'Daten aus der View
Dim x As Integer
Dim y As Integer
Dim strLen As Integer
Dim ses As NotesUIworkspace
Dim vw As NotesUIView
Dim coldocs As NotesDocumentCollection
Dim doc As NotesDocument
Dim it As Variant
Dim strDesc As String
Dim strTrack As String

Set ses = New NotesUIWorkspace
Set vw = ses.currentview
Set coldocs = vw.documents
Set doc = coldocs.getfirstdocument

'Set up Excel
Dim xlApp As Variant
Dim xlSheet As Variant

Set xlApp = CreateObject("Excel.application")
xlApp.Workbooks.Add

Set xlSheet = xlApp.Workbooks(1).Worksheets(1)

'ï¿½berschrift
xlSheet.Cells(1, 1).Value = "Typ"
xlSheet.Cells(1, 2).Value = "Active"
xlSheet.Cells(1, 3).Value = "Anreisser"
xlSheet.Cells(1, 4).Value = "Ansprechpartner"
xlSheet.Cells(1, 5).Value = "Beitrag"
xlSheet.Cells(1, 6).Value = "Datum"
xlSheet.Cells(1, 7).Value = "Title"
xlSheet.Cells(1, 8).Value ="Thema01"
xlSheet.Cells(1, 9).Value ="Thema02"
xlSheet.Cells(1, 10).Value ="Thema03"
xlSheet.Cells(1, 11).Value ="Thema04"
xlSheet.Cells(1, 12).Value ="Thema05"
xlSheet.Cells(1, 13).Value ="Thema06"
xlSheet.Cells(1, 14).Value ="Thema07"
xlSheet.Cells(1, 15).Value ="Thema08"
xlSheet.Cells(1, 16).Value ="Thema09"
xlSheet.Cells(1, 17).Value ="Thema10"
xlSheet.Cells(1, 18).Value ="TopStory"

'Feder formatieren
xlSheet.Columns(1).Columnwidth = 10
xlSheet.Columns(2).Columnwidth = 10
xlSheet.Columns(3).Columnwidth = 10
xlSheet.Columns(4).Columnwidth = 10
xlSheet.Columns(5).Columnwidth = 10
xlSheet.Columns(6).Columnwidth = 10
xlSheet.Columns(7).Columnwidth = 10
xlSheet.Columns(8).Columnwidth = 10
xlSheet.Columns(9).Columnwidth = 10
xlSheet.Columns(10).Columnwidth = 10
xlSheet.Columns(11).Columnwidth = 10
xlSheet.Columns(12).Columnwidth = 10
xlSheet.Columns(13).Columnwidth = 10
xlSheet.Columns(14).Columnwidth = 10
xlSheet.Columns(15).Columnwidth = 10
xlSheet.Columns(16).Columnwidth = 10
xlSheet.Columns(17).Columnwidth = 10
xlSheet.Columns(18).Columnwidth = 10

'xlSheet.Columns(8).Wraptext = True

xlSheet.Columns(1).VerticalAlignment = 1
xlSheet.Columns(2).VerticalAlignment = 1
xlSheet.Columns(3).VerticalAlignment = 1
xlSheet.Columns(4).VerticalAlignment = 1
xlSheet.Columns(5).VerticalAlignment = 1
xlSheet.Columns(6).VerticalAlignment = 1
xlSheet.Columns(7).VerticalAlignment = 1
xlSheet.Columns(8).VerticalAlignment = 1
xlSheet.Columns(9).VerticalAlignment = 1
xlSheet.Columns(10).VerticalAlignment = 1
xlSheet.Columns(11).VerticalAlignment = 1
xlSheet.Columns(12).VerticalAlignment = 1
xlSheet.Columns(13).VerticalAlignment = 1
xlSheet.Columns(14).VerticalAlignment = 1
xlSheet.Columns(15).VerticalAlignment = 1
xlSheet.Columns(16).VerticalAlignment = 1
xlSheet.Columns(17).VerticalAlignment = 1
xlSheet.Columns(18).VerticalAlignment = 1

xlSheet.PageSetup.Orientation = 2

'ï¿½berschrift unterstreichen
xlsheet.Cells(1, 1).Font.Underline = 2
xlsheet.Cells(1, 2).Font.Underline = 2
xlsheet.Cells(1, 3).Font.Underline = 2
xlsheet.Cells(1, 4).Font.Underline = 2
xlsheet.Cells(1, 5).Font.Underline = 2
xlsheet.Cells(1, 6).Font.Underline = 2
xlsheet.Cells(1, 7).Font.Underline = 2
xlsheet.Cells(1, 8).Font.Underline = 2
xlsheet.Cells(1, 9).Font.Underline = 2
xlsheet.Cells(1, 10).Font.Underline = 2
xlsheet.Cells(1, 11).Font.Underline = 2
xlsheet.Cells(1, 12).Font.Underline = 2
xlsheet.Cells(1, 13).Font.Underline = 2
xlsheet.Cells(1, 14).Font.Underline = 2
xlsheet.Cells(1, 15).Font.Underline = 2
xlsheet.Cells(1, 16).Font.Underline = 2
xlsheet.Cells(1, 17).Font.Underline = 2
xlsheet.Cells(1, 18).Font.Underline = 2

xlsheet.PageSetup.PrintTitleRows = "$1:$1"

xlsheet.PageSetup.Zoom = 80

For x = 3 To (coldocs.count + 2)

xlSheet.Cells(x, 1).Value = doc.Typ
xlSheet.Cells(x, 2).Value = doc.Active
xlSheet.Cells(x, 3).Value = doc.Anreisser
xlSheet.Cells(x, 4).Value = doc.Ansprechpartner
'xlSheet.Cells(x, 6).Value = doc.BeitragRTF

'----------------------------------------------------------------------------------------------------------------------
' Hier ist der Teil Wo ich alle Zeilenumbrï¿½che raus haben mï¿½chte
Set it = doc.getfirstitem("BeitragRTF")
strDesc = it.text
' alle returns raus
strLen = Len(strDesc)
For y = 1 To strLen
If Mid(strDesc, y, 1) = Chr(13) Then
Mid(strDesc,y,1)= " "

End If
Next
' modifizierter Inhalt ins Excelfeld
xlSheet.Cells(x, 5).Value = strDesc
'-----------------------------------------------------------------------------------------------------------------------------------
xlSheet.Cells(x, 6).Value = doc.Datum
xlSheet.Cells(x, 7).Value = doc.Titel
xlSheet.Cells(x, 8).Value = doc.Thema01
xlSheet.Cells(x, 9).Value = doc.Thema02
xlSheet.Cells(x, 10).Value = doc.Thema03
xlSheet.Cells(x, 11).Value = doc.Thema04
xlSheet.Cells(x, 12).Value = doc.Thema05
xlSheet.Cells(x, 13).Value = doc.Thema06
xlSheet.Cells(x, 14).Value = doc.Thema07
xlSheet.Cells(x, 15).Value = doc.Thema08
xlSheet.Cells(x, 16).Value = doc.Thema09
xlSheet.Cells(x, 17).Value = doc.Thema10
xlSheet.Cells(x, 18).Value = doc.TopStory

Set doc = coldocs.GetNextDocument(doc)

Next x

Msgbox "Fertig!", 64, "Excel Export"

'Excel wird angeziegt
xlApp.Visible = True
End Sub

GruÃŸ
Hitcher ???
Titel: Re:Excel-Export Script
Beitrag von: Axel am 19.02.03 - 12:11:15: Hi,

sieht doch so ganz gut aus, wo ist denn da Problem ?

Axel
Titel: Re:Excel-Export Script
Beitrag von: LisaS am 19.02.03 - 12:20:09: Hallo Axel,

ich ersetze zwar die Returns durch ein Blank, aber in der Excel Zelle wird der Text trotzdem mit Zeilenumbrüchen angezeigt statt hintereinander zu stehen
ist:
text text text text text text
text text text text text text

soll:
text text text text text text text text text text text text

Gruß
Hitcher
Titel: Re:Excel-Export Script
Beitrag von: Axel am 19.02.03 - 12:43:09: Hi,

hast du eventuell die Excel-Zelle so formatiert, dass ein Zeilenumbruch gemacht wird ?

Prüfe auch mal den String, nach der Ersetzung, ob wirklich kein Zeilenumbruch vorhanden ist. Lasse ihn einfach in einer Messagebox anzeigen. Zum Test versuchs mal mit einem kurzen String.

Eventuell besteht ein Zeilenumbruch nicht nur aus CR (Chr(13)), sondern aus der Kombination CRLF (Chr(13) und Chr(10)).

Axel
Titel: Re:Excel-Export Script
Beitrag von: LisaS am 19.02.03 - 13:09:27: Hallo Axel,

Du hast recht, ich muß Chr(10) auch entfernen.
Im Moment sieht der Teil so aus:

Set it = doc.getfirstitem("BeitragRTF")
      strDesc = it.text
      strLen = Len(strDesc)
      For y = 1 To strLen
         If Mid(strDesc, y, 1) = Chr(13) Then
            Mid(strDesc,y,1)= " "
         End If
         If Mid(strDesc, y, 1) = Chr(10) Then
            Mid(strDesc,y,1)= " "

         End If
      Next

Das Problem ist jetzt nur, daß ich nun teilweise sehr viele Blanks im Text reinbekomme.
Am besten wäre es wenn ich Chr(10) irgendwie löschen könnte statt es mit einem Blank zu ersetzen.
Aber wie? ??? Mid(strDesc,y,1)= "" funktioniert nicht.

Gruß
Hitcher
Titel: Re:Excel-Export Script
Beitrag von: ata am 19.02.03 - 13:47:26: ... mit Trim( ... ) kannst du überflüssige Leerzeichen eliminieren...

ata
Titel: Re:Excel-Export Script
Beitrag von: Axel am 19.02.03 - 13:49:44: Hi ata,

ja, aber nur am Anfang und Ende des Strings, nicht aber in der Mitte.

Axel
Titel: Re:Excel-Export Script
Beitrag von: ata am 19.02.03 - 13:53:49: ... sorry, ich war zu fix - Fulltrimm() nimmt auch die in der Mitte raus...

ata
Titel: Re:Excel-Export Script
Beitrag von: Axel am 19.02.03 - 14:02:03: Hi,

genial, den Befehl kannte ich noch nicht.

Axel
Titel: Re:Excel-Export Script
Beitrag von: LisaS am 19.02.03 - 16:31:29: Hallo Axel und ata,

super vielen Dank für Eure Hilfe.
Jetzt kann ich exportieren bis der Arzt kommt.

Gruß
Hitcher ;D