Attribute VB_Name = "RevisionTables" Sub RevisionTables() ' ' RevisionTables Makro ' ' 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 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 < 13 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 < 13 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 < 13 Then MsgBox "Not enough words" Exit Sub End If 'nahrad + za konec odstavce With ActiveDocument.Range.Find .ClearFormatting .Replacement.ClearFormatting .Text = "+" .Replacement.Text = "^p" .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue End With '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 polickaCZ(i) = Application.CleanString(ActiveDocument.Paragraphs(a).Range.Text) polickaCZ(i) = Left(polickaCZ(i), Len(polickaCZ(i)) - 1) polickaCZ1(i) = polickaCZ(i) a = a + 1 Next i ActiveDocument.Content = "" 'opakuj vse 4x For p = 1 To 4 'zamichej ceska slovicka Randomize For i = 1 To 100 Do nahodneCislo1 = Int(Rnd * (pocetSlov) + 1) nahodneCislo2 = Int(Rnd * (pocetSlov) + 1) Loop Until nahodneCislo1 <> nahodneCislo2 menimeSlovo(1) = polickaCZ(nahodneCislo1) menimeSlovo(2) = polickaCZ(nahodneCislo2) polickaCZ(nahodneCislo2) = menimeSlovo(1) polickaCZ(nahodneCislo1) = menimeSlovo(2) menimeSlovo(1) = polickaAJ(nahodneCislo1) menimeSlovo(2) = polickaAJ(nahodneCislo2) polickaAJ(nahodneCislo2) = menimeSlovo(1) polickaAJ(nahodneCislo1) = menimeSlovo(2) Next i 'jdi na konec dokumentu a vytvor myRange ActiveDocument.Paragraphs.Add Set myRange = ActiveDocument.Content myRange.Collapse Direction:=wdCollapseEnd 'vytvori tabulku ActiveDocument.Tables.Add Range:=myRange, NumRows:=4, NumColumns:=4 ActiveDocument.Tables(p).Columns(1).Width = Application.CentimetersToPoints(4.5) ActiveDocument.Tables(p).Columns(2).Width = Application.CentimetersToPoints(4.5) ActiveDocument.Tables(p).Columns(3).Width = Application.CentimetersToPoints(4.5) ActiveDocument.Tables(p).Columns(4).Width = Application.CentimetersToPoints(4.5) ActiveDocument.Tables(p).Rows.Height = Application.CentimetersToPoints(1.5) 'dej slovicka do tabulky a vykresli ji For i = 1 To 4 nahodneCislo = Int((Rnd * pocetSlov) + 1) ActiveDocument.Tables(p).Cell(i, 1).Range.Text = polickaCZ(nahodneCislo) For j = nahodneCislo To pocetSlov polickaCZ(j) = polickaCZ(j + 1) Next j pocetSlov = pocetSlov - 1 nahodneCislo = Int((Rnd * pocetSlov) + 1) ActiveDocument.Tables(p).Cell(i, 2).Range.Text = polickaCZ(nahodneCislo) For j = nahodneCislo To pocetSlov polickaCZ(j) = polickaCZ(j + 1) Next j pocetSlov = pocetSlov - 1 nahodneCislo = Int((Rnd * pocetSlov) + 1) ActiveDocument.Tables(p).Cell(i, 4).Range.Text = polickaCZ(nahodneCislo) For j = nahodneCislo To pocetSlov - 1 polickaCZ(j) = polickaCZ(j + 1) Next j pocetSlov = pocetSlov - 1 nahodneCislo = Int((Rnd * pocetSlov) + 1) ActiveDocument.Tables(p).Cell(i, 3).Range.Text = polickaAJ(nahodneCislo) For j = nahodneCislo To pocetSlov polickaAJ(j) = polickaAJ(j + 1) Next j pocetSlov = pocetSlov - 1 With ActiveDocument.Tables(p).Cell(i, 1).Borders .OutsideLineStyle = wdLineStyleSingle .OutsideLineWidth = wdLineWidth075pt End With With ActiveDocument.Tables(p).Cell(i, 2).Borders .OutsideLineStyle = wdLineStyleSingle .OutsideLineWidth = wdLineWidth075pt End With With ActiveDocument.Tables(p).Cell(i, 3).Borders .OutsideLineStyle = wdLineStyleSingle .OutsideLineWidth = wdLineWidth075pt End With With ActiveDocument.Tables(p).Cell(i, 4).Borders .OutsideLineStyle = wdLineStyleSingle .OutsideLineWidth = wdLineWidth075pt End With With ActiveDocument.Tables(p).Cell(i, 1).Range .ParagraphFormat.Alignment = wdAlignParagraphLeft End With With ActiveDocument.Tables(p).Cell(i, 2).Range .ParagraphFormat.Alignment = wdAlignParagraphLeft End With With ActiveDocument.Tables(p).Cell(i, 3).Range .ParagraphFormat.Alignment = wdAlignParagraphLeft End With With ActiveDocument.Tables(p).Cell(i, 4).Range .ParagraphFormat.Alignment = wdAlignParagraphLeft End With Next i For j = 1 To pocetSlovorg polickaCZ(j) = polickaCZ1(j) polickaAJ(j) = polickaAJ1(j) Next j pocetSlov = pocetSlovorg Next p End Sub