zadani:
v prvnim odstavci dokumentu je text, zbytek dokumentu prazdny. Makro ma vytisknout vzorkovnik vsech dostupnych fontu tak, ze pro kazdy font vytvori novy odstavec, do nej na zacatek vypise jmeno fontu (fontem Arial, vel. 12) a za nej text z prvniho odstavce timto fontem vel. 12, normalne, tucne a kurzivou. Castecny vystup je v priloze.
moje reseni:
Kód: Vybrat vše
Sub vzornik()
Dim i As Integer
Dim ukazatel As Range
Dim vstup As Range
Dim s As String
'ulozeni celeho prvniho odstavce
Set vstup = ActiveDocument.Paragraphs(1).Range
'vyber zkratime o znak konce odstavce
vstup.End = vstup.End - 1
'nastaveni ukazatele na nejakou hodnotu, jen aby byla promenna inicializovana
Set ukazatel = ActiveDocument.Paragraphs(1).Range
'LandscapeFontNames - objekt, ktery obsahuje jmena vsech dostupnych fontu
For i = 1 To LandscapeFontNames.Count
s = LandscapeFontNames(i)
'pridani noveho odstavce
ActiveDocument.Paragraphs.Add
With ActiveDocument.Paragraphs(i + 1).Range
.Text = s & ": " 'nejdriv vypise na zacatek jmeno fontu
.Font.Reset 'vymaze se puvodni font odstavce
.Font.Name = "Arial" ' a nastavi se na Arial
ukazatel.Start = .End - 1 'ukazatel nastavime na posledni misto pred znakem konce odstavce
ukazatel.End = ukazatel.Start 'a nastavime mu nulovou sirku
ukazatel.InsertAfter (vstup.Text & " ") 'ted za nej vytisknem vstup
ukazatel.End = .End - 1 'ukazatel rozsirime o vsechno co jsme vlozili
ukazatel.Font.Reset 'vymazeme puvodni font
ukazatel.Font.Name = s 'a nastavime na aktulne zpracovavany
ukazatel.Collapse (wdCollapseEnd) 'ukazatel stahneme jen na konec vlozeneho textu
ukazatel.InsertAfter (vstup.Text & " ") 'a pokracujeme dal stejne jako predtim
ukazatel.End = .End - 1
ukazatel.Font.Bold = True 'jen font je uz nastaven, staci jen zmenit na bold
ukazatel.Collapse (wdCollapseEnd) 'a znovu to same
ukazatel.InsertAfter (vstup.Text)
ukazatel.End = .End - 1
ukazatel.Font.Bold = False 'jen ted jeste musime zrusit bold preneseny od predchoziho
ukazatel.Font.Italic = True
.Font.Size = 12 'a celemu odstavci nastavime velikost pisma na 12
End With
Next
End Sub
P.S.: Makro je sice spravne, ale pri spusteni muze trvat hoooodne dlouho nez dobehne (zpomalovano jistou systemovou procedurou ). V labu na Male Strane bezelo asi 2 minuty, v labu v Troji nedobehlo(taky je tu nainstalovanych 861 fontu ...)