Erik Østergaard - Source code snippets / Kildekode småstykker

VBA - source code snippets / - kildekode småstykker

BASIC (Beginner's All-purpose Symbolic Instruction Code) source code snippets / BASIC (Beginner's All-purpose Symbolic Instruction Code) kildekode småstykker

- included the programming languages variants: Basic, VB (Visual Basic), VBA (Visual Basic for Applications), and VBS (VBScript). / - inkluderet programmeringssprog varianterne: Basic, VB (Visual Basic), VBA (Visual Basic for Applications) og VBS (VBScript).

Warning: Don't run the script files without reading them first! / Advarsel: Kør ikke script-filerne uden at læse dem først!

VBA - source code snippets / VBA - kildekode småstykker

Fraktur font: Word macro to change a normal Danish text into the black letter (gothic font). / Fraktur font: Word makro til at lave en almindelig dansk tekst om til fraktur (gotisk skrift).

Description: Macro that changes a normal Danish text into fraktur font as a combination of the fraktur fonts "DSNormalFraktur" and "Frankenstein". One of the old rules for using long s and latin s is observed: Latin s is always used at the end of a word. Consecutive (following one another in uninterrupted succession or order) letters "c" and "h" are changed into the "ch" ligature (a character or type combining two or more letters for example & which is combined e and t). Likewise, "å" is substituted with "aa". / Beskrivelse: Makro, der ændrer en almindelig dansk tekst til fraktur font som en kombination af fraktur skrifttyperne "DSNormalFraktur" og "Frankenstein". En af de gamle regler for brug af lang s og latin s overholdes: Latin s bruges altid i slutningen af et ord. Konsekutive (som følger efter hinanden i uafbrudt rækkefølge eller orden) bogstaverne "c" og "h" er ændret til "ch" ligatur (et skrifttegn eller en type som består af to eller flere sammenskrevne bogstaver, for eksempel & som er sammenskrevet e og t). Ligeledes substitueres "å" med "aa".

Printed black letter (Gothic) alphabet: Black letter-fonts for the Microsoft ® Windows ® program / Trykt gotisk alfabet: Fraktur-skrifttyper for Microsoft ® Windows ® programmet

Overview - Function(s)... / Oversigt - Funktion(er)...

- and Sub procedure(s)... / - og Sub procedure(r)...

A sub procedure is used exactly the same way as a function, the only difference being that it doesn't return a value and therefore can't be used as part of an argument. Sub procedures are used by Visual Basic to provide event handling. / En sub procedure anvendes på nøjagtig samme måde som en funktion, den eneste forskel er, at den ikke returnerer en værdi, og derfor ikke kan bruges som en del af et argument. Sub procedurer anvendes af Visual Basic til at tilvejebringe begivenhed håndtering.

• Sub fraktur

Developed and tested under Microsoft Office Word 97 - English version and for some functions only or also under Microsoft Office Word 2003 - English version. / Udviklet og testet under Microsoft Office Word 97 - engelsk version og for nogle funktioner kun eller også under Microsoft Office Word 2003 - engelsk version.

' All variables must be declared before use.
Option Explicit

Public Sub fraktur()
On Error GoTo Err_fraktur
'
' Macro that changes a normal Danish text into fraktur font
' as a combination of the fraktur fonts "DSNormalFraktur" and
' "Frankenstein".  One of the old rules for using long s and
' latin s is observed: Latin s is always used at the end of a
' word.  Consecutive letters "c" and "h" are changed into the
' "ch" ligature.  Likewise, "å" is substituted with "aa".

    Selection.WholeStory
    
    Dim repl(0 To 18) As Variant  ' Search/replacement strings.
    
    ' Keep all existing plus signs (¥ displays as a plus sign).
    repl(0) = Array("+", "¥")
    ' The plus sign (+) is displayed as a latin s
    ' (the s, when unchanged, is displayed as a long s).
    repl(1) = Array("s ", "+ ")
    repl(2) = Array("s,", "+,")
    repl(3) = Array("s.", "+.")
    repl(4) = Array("s;", "+;")
    repl(5) = Array("s:", "+:")
    repl(6) = Array("s-", "+-")
    repl(7) = Array("s!", "+!")
    repl(8) = Array("s?", "+?")
    repl(9) = Array("s""", "+""")
    repl(10) = Array("s'", "+'")
    repl(11) = Array("s)", "+)")
    repl(12) = Array("s]", "+]")
    repl(13) = Array("s]", "+]")
    repl(14) = Array("ch", "@x@")
    ' The dollar sign ($) is displayed as a standard c letter.
    repl(15) = Array("c", "$")
    repl(16) = Array("@x@", "c")
    repl(17) = Array("å", "aa")
    repl(18) = Array("Å", "Aa")
    ' repl(19) = Array("ss", "+s")
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    
    With Selection.Find
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    
    Dim pair
    
    For Each pair In repl
      With Selection.Find
          .Text = pair(0)
          .Replacement.Text = pair(1)
      End With
      Selection.Find.Execute Replace:=wdReplaceAll
    Next pair
    
    ' Change to extra line spacing suitable for the fraktur font.
    With Selection.ParagraphFormat
        .LineSpacingRule = wdLineSpaceMultiple
        .LineSpacing = LinesToPoints(1.3)
    End With
    
    ' Change font into the base fraktur font.
    With Selection.Font
        .Name = "DSNormalFraktur"
        '.Size = 14
        .Bold = False
        .Italic = False
        .StrikeThrough = False
        .DoubleStrikeThrough = False
        .Outline = False
        .Emboss = False
        .Shadow = False
        .Hidden = False
        .SmallCaps = False
        .AllCaps = False
        .ColorIndex = wdAuto
        .Engrave = False
        '.Superscript = False
        '.Subscript = False
        .Spacing = 0.1
        .Scaling = 100
        .Position = 0
        .Kerning = 0
        .Animation = wdAnimationNone
    End With

    ' Change a few characters into a different fraktur font.
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Name = "Frankenstein"
    With Selection.Find
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    
    Dim list(0 To 3) As String
    list(0) = "æ"
    list(1) = "Æ"
    list(2) = "ø"
    list(3) = "Ø"
    
    Dim stuff
    
    For Each stuff In list
      With Selection.Find
          .Text = stuff
          .Replacement.Text = stuff
      End With
      Selection.Find.Execute Replace:=wdReplaceAll
    Next stuff
    
    Selection.HomeKey Unit:=wdStory
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "s"
        .Replacement.Text = "+"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    
    MsgBox Prompt:="The macro has automatically used ""short s"" when the s is at the end of the word.  " & _
           "Replace if necessary yourself some of the remaining ""long s"" with " & _
           "short s by pressing Ctrl+H (Find and Replace: Replace), search for ""s"" and replace " & _
           "with ""+"" (the plus sign appears as short s).  There should be at least " & _
           "used short s at all word endings even when words are written together.  " & _
           "Examples of short s: Frederiksberg, husmor (housewife), and lodsejer (site owner)." & _
           " / " & _
           vbNewLine & _
           "Makroen har automatisk anvendt ""kort s"" når s'et er sidst i ordet.  " & _
           "Udskift evt. selv nogle af de resterende ""lange s'er"" med " & _
           "korte s'er ved at trykke på Ctrl+H (Søg og Erstat: Erstat), søge efter ""s"" og erstatte " & _
           "med ""+"" (plustegnet vises som kort s).  Der bør som minimum " & _
           "anvendes kort s ved alle ordslutninger også når ord er skrevet sammen.  " & _
           "Eksempler på korte s'er: Frederiksberg, husmor og lodsejer.", _
           Title:="Info !", buttons:=vbInformation + vbOKOnly
           
Exit_fraktur:
    Exit Sub

Err_fraktur:
    MsgBox Err.Number & ": " & Err.Description
    Resume Exit_fraktur

End Sub

Conventions used for: Source code syntax highlighting. / Regler brugt til: Kildekode syntaks fremhævning.

1 Implementation: (How to use:) /
1 Implementering: (Sådan bruger du:)

Word: / Word:

1. Open a new Word Document or Open an existing Word Document /
   Åben et nyt Word Dokument eller Åben et eksisterende Word Dokument
2. Copy the code above /
   Kopier koden ovenfor
3. Press Alt+F11 to open the 'Visual Basic Editor (VBE)' /
   Tryk Alt+F11 for at åbne 'Visual Basic Editor (VBE)'
4. Select INSERT > (general) MODULE from the menubar /
   Vælg INDSÆT > (generelt) MODUL fra menulinien
5. Paste code into the right (top) panel /
   Indsæt kode i det højre (top) panel
6. Press Alt+Q to return to Word /
   Tryk Alt+Q for at returnere til Word

2 Implementation: (How to use:) /
2 Implementering: (Sådan bruger du:)

Word: / Word:
- only if there above was chosen "Open a new Word Document" /
- kun hvis der ovenfor blev valgt "Åben et nyt Word Dokument"

1. Copy the Danish example text above /
   Kopier den danske eksempel tekst ovenfor
2. Paste the Danish example text above into the new empty Word Document /
   Indsæt den danske eksempel tekst ovenfor i det nye tomme Word Dokument

3 Implementation: (How to use:) /
3 Implementering: (Sådan bruger du:)

Word: / Word:

1. Go to TOOLS > MACRO > MACROS /
   Gå til VÆRKTØJER > MAKRO > MAKROER
2. When the dialog appears, select (fraktur) /
   Når dialogen kommer til syne vælg (fraktur)
3. Press Run /
   Tryk Kør

4 Implementation: (How to use:) /
4 Implementering: (Sådan bruger du:)

Word: / Word:

1. When finished save or do not save the document /
   Når færdig gem eller gem ikke dokumentet

Source code snippets / Kildekode småstykker

- often included as functions for use in modules with program code, macros, and scripts etcetera. / - mange gange inkluderet som funktioner til brug i moduler med programkode, makroer og scripts og så videre.

The code might need some minor tweaks to run in your application. / Koden kan behøve nogle mindre ændringer for at kunne afvikles i dit anvendelsesområde.

Licence: Free to use, but please share improvements. No warranty - use at own risk. /
Licens: Fri brug, men del venligst forbedringer. Ingen garanti - brug på eget ansvar.

Warning: Don't run the script files without reading them first!
Total absence of any guarantee, warranty, or responsibility for script files, the script(s), the files they may produce, or the effects the script(s) or script-produced files may have. The script(s) is, after all, plain text. The burden is on the person using the script(s) to examine the script source code and determine whether or not a script is usable and safe. Operating systems and browsers are constantly changing. What works today may not work tomorrow!

Advarsel: Kør ikke script-filerne uden at læse dem først!
Totalt fravær af nogen form for garanti, garanti eller ansvar for script-filer, scriptet(scriptene), de filer, de kan producere eller de virkninger, scriptet(scriptene) eller scriptproducerede filer kan have. Scriptet(Scriptene) er, trods alt, almindelig tekst. Byrden er på brugeren af scriptet(scriptene) til at undersøge script kildekoden og afgøre, hvorvidt et script er brugbart og sikkert. Operativsystemer og browsere er under konstant forandring. Hvad fungerer i dag, fungerer muligvis ikke i morgen!