Text in Tabelle umwanden - Anzahl der Spalten begrenzen

[lorenz82]

Hallo,
ich habe folgendes Problem. Ein Programm ruft ein Word-Dokument auf und trägt automatisch eine unbestimmte Anzahl an Werten in das Dokument ein. Ich kann festlegen wo die Werte im Dokument eingetragen werden und wie das Format sein soll. Aussehen würde es dann z.B. so:

Code: Alles auswählen

$Name1;$Wert1;$Wert2;$Wert3;$Wert4;$Wert5
$Name2;$Wert6;$Wert7;$Wert8
$Name3;$Wert9;$Wert10;$Wert11;Wert12;$Wert13;$Wert14;$Wert15;$Wert16;$wert17
.....
$NameN;$WertN

Die Umwandlung des Textblocks in eine Tabelle mache ich als Makro, als Zellen-Trenner wird dann das Semikolon genutzt. In dem Programm kann man leider nicht die Anzahl der einzutragenden Werte festlegen - es kann passieren, dass zu einem Namen 30 Werte eingetragen werden. Für die Formatierung der Tabelle muss ich aber die Anzahl der Spalten begrenzen. Gibt es in Word eine Möglichkeit, dass man die Anzahl der Werte (also im Beispiel oben $Wert1 und $Wert2) auf eine bestimmte Anzahl zu begrenzen, sodass z.B. nur die letzten 5 Werte übrig bleiben. Also dass das Beispiel von oben danach dann so aussehen würde:

Code: Alles auswählen

$Name1;$Wert1;$Wert2;$Wert3;$Wert4;$Wert5
$Name2;$Wert6;$Wert7;$Wert8
$Name3;$Wert13;$Wert14;$Wert15;$Wert16;$wert17
.....
$NameN;$WertN

Oder gibt es in Word eine andere Möglichkeit festzulegen, dass eine Tabelle max. 6 Spalten hat (also eine Spalte für den Namen und 5 Spalten für die Werte?) und dass nur die letzten 5 Werte in die Tabelle eingefügt werden?

Vielen Dank im Voraus,


Hannes

[theoS]

Was fügt das Prog denn am Ende des Datensatzes ein? Zeilenumbruch?
Dann könntest du bevor du Text in Tabelle machst die Wörter von da weg rückwärts löschen.

[lorenz82]

Hallo,

erst mal vielen Dank für Deine Antwort. Man kann in dem Programm einstellen, wie die Daten eingefügt werden sollen inkl, ob die einzelnen Zeilen per Tab, Line-Feed oder Carriage-Return beendet werden sollen. Im Moment werden sie per Carriage return umgebrochen, es wär aber kein großer Aufwand es z.B. in Line-Feed zu ändern.

Ich hab in der Zwischenzeit noch selber weiter probiert, komme aber nicht so richtig voran. Ich habe ein Makro erstellt, dass die einzelnen Zeilen in ein Array aufteilt (also nach jedem Carriage Return wird ein neues rAray-Element erzeugt.). Das funktioniert soweit ich es sehe auch. Also so:

Array(0): $Name1;$Wert1;$Wert2;$Wert3;$Wert4;$Wert5
Array(1): $Name2;$Wert6;$Wert7;$Wert8
Array(2): $Name3;$Wert9;$Wert10;$Wert11;Wert12;$Wert13;$Wert14;$Wert15;$Wert16;$wert17

und so weiter. Wodran es grad hakt ist zu überprüfen, ob in dem Array-Element mehr als 6 Werte vorkommen. Da komm ich nicht weiter.

Code: Alles auswählen

Sub cut_values()
'
' cut_values Makro
'
'
'Variable text enthält alle Werte, so wie es das Programm in dem Dokument einträgt
Dim text      As String

'Array zum trennen der Zeilen per Carriage-Return
Dim werte_array As Variant

'Array zum Überprüfen der Anzahl der Werte
Dim werte_array_temp As Variant

Dim i As Integer

text = ActiveDocument.Bookmarks("werte").Range
cText = "Ahaaaaa"
   werte_array = Split(text, vbCr)
   For i = LBound(werte_array) To UBound(werte_array)
   werte_array_temp = werte_array(i)
  Selection.TypeText text:=werte_array_temp & vbCr & cText & vbCr
  If UBound(werte_array_temp()) > 6 Then
        Selection.TypeText text:=werte_array_temp & vbCr & cText & vbCr
        msg = msg & werte_array_temp(0)
        msg = msg & werte_array_temp(1)
        msg = msg & werte_array_temp(2)
        msg = msg & werte_array_temp(3)
        msg = msg & werte_array_temp(4)
        msg = msg & werte_array_temp(5)
        msg = msg & werte_array_temp(6)
    Else
        msg = msg & werte_array_temp
    End If
Next i


Nicht wundern. Die Zeilen , in denen ein Text ausgegeben wird sind nur zum debugging gedacht. Der Code läuft in einem Test-Dokument einmal durch (also mit der ersten Zeile), dann kommt die Fehlermeldung: "Laufzeitfehler '9': Index ußerhalb des gültigen Bereichs". Wenn ich dann auf die Schaltfläche "Debuggen" klicke, markiert er die Zeile

Code: Alles auswählen

If UBound(werte_array_temp()) > 8 Then


Gruß,

Hannes

[halweg]

werte_array_temp ist eine Textzeile, kein array. Die müsstest du ja auch erst mal per Split(...,";") auseinandernehmen.

[lorenz82]

ähm ja...ich war der Meinung, ich hätte die 2. Split-Anweisung auch eingegeben. Vielen Dank für den Hinweis auf den Fehler.

Gruß,

Hannes

[theoS]

so?

Code: Alles auswählen

    Sub cut_values()
    '
    ' cut_values Makro
    '
    '
    'Variable text enthält alle Werte, so wie es das Programm in dem Dokument einträgt
    Dim text      As String
    Dim dd1 As Document: Set dd1 = ActiveDocument

    Dim werte_array As Variant, lX As Long, arrL As Variant, strRepl As String
    'Array zum Überprüfen der Anzahl der Werte
    Dim werte_array_Temp As Variant

    Dim i As Integer

    text = ActiveDocument.Bookmarks("werte").Range
    cText = "Ahaaaaa"
       werte_array = Split(text, vbCr)
       For i = LBound(werte_array) To UBound(werte_array)
       werte_array_Temp = werte_array(i)

    arrL = Split(werte_array_Temp, ";")
    lX = UBound(arrL)
    If lX >= 6 Then
 
     strRepl = arrL(0) &  ";" & arrL(lX - 4) & ";" & arrL(lX - 3) & ";" & arrL(lX - 2) & ";" & arrL(lX - 1) & ";" & arrL(lX) & vbCrLf
     Else
     strRepl = werte_array_Temp & vbCrLf
     End If
     Debug.Print strRepl
    Next i


End Sub

[lorenz82]

Hallo,

Makro ist nun fertig. Ich kann es zwar gerade nicht mit dem Programm testen, aber mit einem Dummy-Dokument funktioniert es wie gewünscht. Also nochmal vielen Dank für die Denkanstöße hier. Ich weiß allerdings nicht, ob mein Weg besonders "elegant" ist - ich hab mich nie tiefgehend mit vba beschäftigt sondern nur mit den Tipps von hier und googlen beholfen. Aber falls nochmal jemand vor so einem Problem steht (oder einem ähnlichen), hier das Makro:

Code: Alles auswählen

Sub cut_values()
'
' cut_values Makro
'
'
Dim text As String
Dim werte_array As Variant
Dim werte_array_temp As Variant
Dim oRNG As Range
Dim oBM As Bookmark
Dim i As Integer
Dim anzahl_elemente As Integer

'' Von ICM exportierte Laborwerte einlesen und anhand von Carriage-return trennen
text = ActiveDocument.Bookmarks("werte").Range
werte_array = Split(text, vbCr)

For i = LBound(werte_array) To UBound(werte_array)
    '' Die einzelnen Werte des Analyten anhand des Semikolons trennen und überprüfen, ob mehr als 5 Laborwerte existieren (5 Laborwerte + je eine Spalte für den Namen, die Einheit und den Referenzbereich --> 8 Spalten
    '' Danach werden die einzelnen Werte in die Variable msg eingetragen
    werte_array_temp = Split(werte_array(i), ";")
    anzahl_elemente = UBound(werte_array_temp) - LBound(werte_array_temp) + 1
    If anzahl_elemente > 8 Then
        msg = msg & werte_array_temp(0) & ";"
        msg = msg & werte_array_temp(1) & ";"
        msg = msg & werte_array_temp(2) & ";"
        msg = msg & werte_array_temp(7) & ";"
        msg = msg & werte_array_temp(6) & ";"
        msg = msg & werte_array_temp(5) & ";"
        msg = msg & werte_array_temp(4) & ";"
        msg = msg & werte_array_temp(3) & vbCr
    Else
        msg = msg & werte_array_temp(0) & ";"
        msg = msg & werte_array_temp(1) & ";"
        msg = msg & werte_array_temp(2) & ";"
        For j = UBound(werte_array_temp) To 3 Step -1
        msg = msg & werte_array_temp(j) & ";"
        Next j
        msg = Left(msg, Len(msg) - 1) '' Nach dem letzten Wert darf kein Semikolon stehen, also wird das Semikolon des letzten Werte gelöscht
        msg = msg & vbCr '' Carriage-return einfügen
    End If
Next i

'' Textmarke "neue_werte mit dem Inhalt von msg füllen
Set oRNG = ActiveDocument.Bookmarks("neue_werte").Range
oRNG.text = msg
Set oBM = ActiveDocument.Bookmarks.Add( _
    Name:="neue_werte", _
    Range:=oRNG)

'' Die Textmarke neue_werte selektieren und die Tabelle zeichnen
Selection.GoTo What:=wdGoToBookmark, Name:="neue_werte"
    With ActiveDocument.Bookmarks
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    End With
Selection.ConvertToTable Separator:=wdSeparateByCommas, AutoFitBehavior:=wdAutoFitFixed
    With Selection.Tables(1)
        .Style = "Tabellenraster"
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = False
    End With
End Sub


Gruß,

Hannes

[theoS]

Also, ich hatte deinen Post so verstanden, dass die letzten Werte eingefügt werden. Mit deinem Code prüfst du zwar > 8, aber irgendwie kommen in deine Tabelle ja dann immer nur die Werte 8, 7, 6, 5, 4, egal wie viele da noch kommen. Ist das gewollt?

[lorenz82]

Hallo,

Du hast Recht. In meinem ersten Post ging ich noch davon aus, dass die Sortierung "von alt nach neu" ist. Erst beim Schreiben des Makros hab ich in der Gebrauchsanleitung zu dem externen Programm gelesen, dass man die Sortierung auch umdrehen kann (also "von neu nach alt"). Deshalb werden nun die ersten 8 Werte in die Tabelle eingetragen.

Hannes