Vsi nabori znakov v vašem računalniku

V dneh, ko “se ženijo ptički” in ko praznujemo uvoženi praznik zaljubljencev, se uporabniki spomnite, da bi lahko soljudem poslali kakšno misel, verz… nekaj lepega pač.

Seveda pa ne želite, da bi to izpadlo kar tako malo mimo, temveč bi želeli to izpisati s kakšno lepo pisavo in na računalniku imate 200 pisav, pa sploh ne veste:

1. Kako izgledajo
2. Ali znajo natisniti Č, Š in Ž

Spodaj vam prilagam majhen makro, ki vam bo v Wordu izdelal tabelo vseh naborov znakov, ki jih vaš računalnik pozna. Hkrati pa boste tudi videli ali izbrana pisava zna natisniti črke Č, Š in Ž (prilagam pa tudi datoteko, ki makro že vsebuje 😉 ):

Sub VsiFonti()
  Application.ScreenUpdating = False

  Dim doc As Document: Set doc = Documents.Add

  Dim tabela As Table: Set tabela = doc.Tables.Add(Selection.Range, FontNames.Count + 1, 2)

  With tabela
    .Borders.Enable = False
    .Cell(1, 1).Range.Font.Name = "Arial"
    .Cell(1, 1).Range.Font.Bold = 1
    .Cell(1, 1).Range.InsertAfter "Font"
    .Cell(1, 2).Range.Font.Bold = 1
    .Cell(1, 2).Range.InsertAfter "Primer izpisa"
  End With

  Dim vrst As Integer
  For vrst = 1 To FontNames.Count
    With tabela
      .Cell(vrst + 1, 1).Range.Font.Name = "Arial"
      .Cell(vrst + 1, 1).Range.Font.Size = 10
      .Cell(vrst + 1, 1).Range.InsertAfter FontNames(vrst)
      .Cell(vrst + 1, 2).Range.Font.Name = FontNames(vrst)
      .Cell(vrst + 1, 2).Range.Font.Size = 10
      .Cell(vrst + 1, 2).Range.InsertAfter "ABCČDEFGHIJKLMNOPRSŠTUVZŽ" & vbCr & _
         "ABCČDEFGHIJKLMNOPRSŠTUVZŽ" & vbCr & "0123456789"
    End With
  Next vrst

  tabela.Sort SortOrder:=wdSortOrderAscending

  Application.ScreenUpdating = True
End Sub

Prilagam pa tudi datoteko, ki omenjen makro že vsebuje in vse kar morate storiti je da:

1. datoteko odprete,
2. omogočite makre,
3. pritisnete velik gumb ‘Izpiši vse pisave v mojem računalniku…’

..:: Datoteka z makrom ::..