Tekst sorteren VBA

[Sanoek]

Ik heb een bestand in MS Word (2007) formaat. Deze bevat honderden rapporten gescheiden door een sectie einde(volgende pagina). Elke rapport bevat 1 tabel met daarin meerdere geneste tabellen met tekst en grafieken plus kop en voettekst.

In de eerste rij van iedere tabel staat een regel. Die regels staan in een excel sheet inclusief rapportnummer. Ik moet de rapporten in Word sorteren op dit rapportnummer.

Hoe pak je dit aan?

 

[OctaFish]

Niet; sorteren doe je op Alineaniveau in Word. Je zou nog kunnen overwegen om een kopstijl (Kop1) te gebruiken en in de overzichtsweergave op Niveau 1 te sorteren. Wat dat doet met je tabel weet ik niet, maar ik vermoed dat die zich als gewone tekst gedragen, en netjes in de tabellen blijven staan.

 

[Sanoek]

Niet; sorteren doe je op Alineaniveau in Word. Je zou nog kunnen overwegen om een kopstijl (Kop1) te gebruiken en in de overzichtsweergave op Niveau 1 te sorteren. Wat dat doet met je tabel weet ik niet, maar ik vermoed dat die zich als gewone tekst gedragen, en netjes in de tabellen blijven staan.

Hallo Michel,

Bedankt voor je snelle reactie. Ik denk dat ik mijn probleem niet goed heb uitgelegd.

Als ik jou suggestie volg, dan worden alle tabellen aan elkaar geplakt en de vervolgens gesorteerd op een tekstachtige manier. Mijn sorteer argument is een volgordenummer die ik eerst met Vlookup in excel moet ophalen en plakken in A1 en vervolgens moeten alle tabellen worden gesorteerd op basis van dat volgnummer in A1 van iedere tabel.

De code van Paul Edstein [MS MVP - Word] http://social.technet.microsoft.com...7b9413ae/how-to-sort-the-tables-in-a-document komt nog het meest in de buurt van een oplossing. Maar ook die oplossing is op tekst gebaseerd. Ik wil de sortering op een numeriek veld (A1) doen.

Enig idee?

Groeten,

Jos

 

[OctaFish]

Word is een tekstverwerker; tekstverwerkers beschouwen tekst als tekst. Is niet onlogisch... 9 is dus groter dan 121. Wil je correct op 'numerieke' tekst sorteren, dan moet je voorloopnullen toevoegen. Dan is 009 weer kleiner dan 121.

 

[OctaFish]

Mocht je nog geïnteresseerd zijn in een oplossing: ik heb de code een beetje aangepast, zodat hij nu ook numeriek goed sorteert. De code werkt overigens alleen als de eerste cel een getal bevat; inhoud als: 'Volgnummer 1" .. 'Volgnummer 145" gaat nog steeds niet, tenzij je de code weer verder opsplitst en het nummer eruit vist. Ook nog wel te doen overigens.

Sub TabellenSorterenNumeriek()
Application.ScreenUpdating = False
Dim i As Long, j As Long, k As Long
Dim strVal As String, StrTbls As String
Dim RngOld As Range, RngNew As Range, bClr As Boolean
Dim tmpArr As Variant

    bClr = False
    With ActiveDocument
        If .Tables.Count < 2 Then GoTo CleanUp
        If .Paragraphs.First.Range.Information(wdWithInTable) = True Then
            .Tables(1).Range.Cut
            .Paragraphs.First.Range.InsertBefore vbCr & vbCr
            .Range.Paragraphs.First.Range.Characters.Last.Next.Paste
            bClr = True
        End If
        
Restart:
        StrTbls = ""
        For i = 1 To .Tables.Count
            strVal = Left(.Tables(i).Cell(1, 1).Range.Text, Len(.Tables(i).Cell(1, 1).Range.Text) - 2)
            If Not StrTbls & "" = "" Then StrTbls = StrTbls & "," & strVal Else: StrTbls = strVal
        Next
        tmpArr = Split(StrTbls, ",")
        For i = LBound(tmpArr) To UBound(tmpArr) - 1
            For j = i + 1 To UBound(tmpArr)
                If CInt(tmpArr(j)) < CInt(tmpArr(i)) Then
                    Set RngOld = .Tables(j + 1).Range
                    With RngOld
                        If .Paragraphs.Last.Next.Range.Text = vbCr Then .Paragraphs.Last.Next.Range.Delete
                        .Cut
                    End With
                    Set RngNew = .Tables(i + 1).Range.Paragraphs.First.Previous.Range.Characters.Last
                    With RngNew
                        .Collapse wdCollapseStart
                        .InsertAfter vbCr
                        .Collapse wdCollapseEnd
                        .Paste
                    End With
                    GoTo Restart
                End If
            Next
        Next
    
CleanUp:
        If bClr = True Then .Paragraphs.First.Range.Delete
    End With
    
    Set RngOld = Nothing
    Set RngNew = Nothing
    Application.ScreenUpdating = True
End Sub