Attribute VB_Name = "OrderText"
Sub OrderText()
'
'
'
'Zamichej pole
'
'
Dim cisloSlova(1000) As Integer
Dim polickaAJ(1000) As String
Dim pocetSlovorg As Integer
Dim polickaCZ(1000) As String
Dim polickaAJ1(1000) As String
Dim polickaCZ1(1000) As String
Dim pocetSlov As Integer
Dim nahodneCislo1 As Integer
Dim nahodneCislo2 As Integer
Dim slovo1 As String
Dim slovo2 As String
Dim reseniCislo1 As Integer
Dim reseniCislo2 As Integer
Dim menimeSlovo(2) As String

Randomize
ActiveDocument.Range.Paragraphs.SpaceAfter = 0
With ActiveDocument.PageSetup
    .BottomMargin = Application.CentimetersToPoints(1)
    .TopMargin = Application.CentimetersToPoints(1)
End With

'zkontroluje, zde je dost slovicek
If ActiveDocument.Paragraphs.Count < 2 Then
MsgBox "Not enough words"
Exit Sub
End If



'vymaze prazdne radky
Do
If Len(ActiveDocument.Paragraphs.Last.Range.Text) < 3 Then ActiveDocument.Paragraphs.Last.Range.Delete
Loop Until Len(ActiveDocument.Paragraphs.Last.Range.Text) > 3

'zkontroluje, zde je dost slovicek
If ActiveDocument.Paragraphs.Count < 2 Then
MsgBox "Not enough words"
Exit Sub
End If

pocetSlov = ActiveDocument.Paragraphs.Count
i = 0
Do
    i = i + 1
    If Len(ActiveDocument.Paragraphs(i).Range.Text) < 3 Then
            ActiveDocument.Paragraphs(i).Range.Delete
            pocetSlov = ActiveDocument.Paragraphs.Count
            i = i - 1
            
            End If
Loop While pocetSlov > i + 1

pocetSlov = ActiveDocument.Paragraphs.Count
pocetSlovorg = pocetSlov

'zkontroluje, zde je dost slovicek
If ActiveDocument.Paragraphs.Count < 2 Then
MsgBox "Not enough words"
Exit Sub
End If



'nacti slovicka do pole
a = 1

For i = 1 To pocetSlov

    polickaAJ(i) = Application.CleanString(ActiveDocument.Paragraphs(a).Range.Text)
    polickaAJ(i) = Left(polickaAJ(i), Len(polickaAJ(i)) - 1)
    polickaAJ1(i) = polickaAJ(i)
   
    
    a = a + 1
    
Next i
ActiveDocument.Content = ""



'vyber vsechny radky a ocisluj je
Dim jenpatnactCZ(100) As String
Dim jenpatnactAJ(100) As String
Dim jenpatnactcisel(100) As String

For x = 1 To pocetSlov
    jenpatnactAJ(x) = polickaAJ(x)
    jenpatnactcisel(x) = x
Next x
'zamichej anglicka a cisla
For x = 1 To 30
    nahodnecislo = 1 + Int(Rnd * pocetSlov)
    tempslovoAJ = jenpatnactAJ(1)
    tempcislo = jenpatnactcisel(1)
    jenpatnactcisel(1) = jenpatnactcisel(nahodnecislo)
    jenpatnactAJ(1) = jenpatnactAJ(nahodnecislo)
    jenpatnactcisel(nahodnecislo) = tempcislo
    jenpatnactAJ(nahodnecislo) = tempslovoAJ
Next x
'najdi nejdelsi slova a nastav siri tabulky
maxdelkaslovaAJ = 3
maxdelkaslovaCZ = 3
For x = 1 To pocetSlov
    DelkaSlova = Len(jenpatnactAJ(x))
    If maxdelkaslovaAJ < DelkaSlova Then maxdelkaslovaAJ = DelkaSlova
    
Next x
maxdelkaslovaAJ = 1.1 + Int(maxdelkaslovaAJ / 10)
If maxdelkaslovaAJ > 6 Then maxdelkaslovaAJ = 6
'vloz tabulky do kterych das zadani a reseni

 ActiveDocument.Paragraphs.Add

Set myRange = ActiveDocument.Content
myRange.Collapse Direction:=wdCollapseEnd
ActiveDocument.Tables.Add Range:=myRange, NumRows:=pocetSlov, NumColumns:=2

ActiveDocument.Paragraphs.Add
Set myRange = ActiveDocument.Content
myRange.Collapse Direction:=wdCollapseEnd
ActiveDocument.Tables.Add Range:=myRange, NumRows:=pocetSlov, NumColumns:=2

ActiveDocument.Tables(1).Columns(2).Width = InchesToPoints(maxdelkaslovaAJ)
ActiveDocument.Tables(1).Columns(1).Width = InchesToPoints(0.3)
ActiveDocument.Tables(1).Rows.Alignment = wdAlignRowLeft
ActiveDocument.Tables(1).Spacing = 4
ActiveDocument.Tables(1).Columns(1).Cells.Borders.InsideLineStyle = wdLineStyleSingle
ActiveDocument.Tables(1).Columns(1).Cells.Borders.OutsideLineStyle = wdLineStyleSingle

ActiveDocument.Tables(2).Columns(2).Width = InchesToPoints(maxdelkaslovaAJ)
ActiveDocument.Tables(2).Columns(1).Width = InchesToPoints(0.3)

For xxx = 1 To pocetSlov
    ActiveDocument.Tables(1).Rows(xxx).Cells.VerticalAlignment = wdCellAlignVerticalCenter
    ActiveDocument.Tables(2).Rows(xxx).Cells.VerticalAlignment = wdCellAlignVerticalCenter
    
    ActiveDocument.Tables(1).Rows(xxx).Cells(2).RightPadding = 0
Next xxx
'dej slova do tabulek
For x = 1 To pocetSlov
    ajText = jenpatnactAJ(x)
    ActiveDocument.Tables(1).Cell(x, 2).Range.Text = ajText
    ActiveDocument.Tables(2).Cell(x, 2).Range.Text = ajText
    ActiveDocument.Tables(2).Cell(jenpatnactcisel(x), 1).Range.Text = Str(x)
Next x

End Sub