Druckansicht der Seite "Zeichensatztabelle für ANSI und Unicode mit WinWord erstellen"
Website der Firma Transcom, Deutschland
Pfad zu dieser Seite » Home  > Tipps + Tricks  > MS Windows  > ANSI- und Unicode-Zeichensatz
URL dieser Seite www.transcom.de/transcom/de/tipps-tricks/windows/2001_zeichensatztabelle.htm
 
Ihre Optionen Zum Ausdrucken benutzen Sie bitte die Druckfunktion Ihres Browsers.
(Zurück) zur Webansicht dieser Seite  
 

Zeichensatztabelle für ANSI und Unicode mit WinWord erstellen

Situation

Sie suchen ein bestimmtes Zeichen, wissen aber nicht ob es in dem jeweiligen Font überhaupt vorhanden ist bzw. an welcher Position es sich befindet.

Lösung

Sie könnten mit |- Start | Programme | Zubehör | Systemprogramme | Zeichentabelle -| sich einen ANSI-Zeichensatz auf den Bildschirm holen. Diesen Zeichensatz können Sie aber nicht drucken und Unicode-Zeichen werden auch erst seit Windows 2000 angezeigt. Also:

Laden Sie sich die WinWord-Datei

(Link intern) ZeichensatzTabelle.doc
(ca. 90 kByte)

herunter (rechte [!] Maustaste und im Kontextmenü "Speichern unter" wählen, wenn der linke Mausklick nicht funktionieren will) und öffnen dieses in Microsoft WinWord 97 oder höher. (Wenn die Frage nach Makros erscheint, diese aktivieren.) Dieses enthält die notwendigen Makros (für jeden einsehbar) und ein zusätzliches Menü |- Zeichensatz -|, über das Sie sich eine ANSI- oder Unicode-Tabelle für einen beliebigen Font erstellen können.

Hinweis: Wenn ZeichensatzTabelle.doc statt auf Festplatte gespeichert zu werden, direkt im Browser geöffnet wird, funktionieren die Makros nicht! In diesem Falle mit |- Datei | Speichern unter -| das Dokument auf Festplatte speichern und schließen - und in WinWord wieder öffnen.

Anmerkung

Falls Sie Angst vor Makroviren haben, hier ist der Quellcode der Version 1.0 zum Herauskopieren — die aktuelle Version ist 1.1, die vor allem die Erstellung der Unicode-Tabelle auch so erlaubt, dass keine Zwischenfragen gestellt werden (Einzüge im Quellcode sind beim Konvertieren in diese Webseite leider verloren gegangen). Die Start*-Makros sind jene, die Sie aus WinWord heraus aufrufen müssen.

———————————
Sub CopyrightLizenz()
Rem Copyright 2001 Johannes Graubner
Rem Lizenz: ZeichensatzTabelle ist Open Source gemäß GNU GPL (siehe www.fsf.org)
Rem Weitergabe nur vollständig und unentgeltlich

x = MsgBox("Copyright 2001 Johannes Graubner" + Chr$(13) + _
"Lizenz: ZeichensatzTabelle ist Open Source gemäß GNU GPL (siehe www.fsf.org)" + Chr$(13) + _
"Weitergabe nur vollständig und mit frei zugänglichem Quellcode", vbOKOnly, _
"Copyright + Lizenz")

End Sub

———————————
Sub StartANSI16()
REM ANSI-Zeichensatz mit 16 Spalten

Zeichensatz "ANSI", 16

End Sub
———————————
Sub StartUnicode16()
REM Unicode-Zeichensatz mit 16 Spalten

Zeichensatz "Unicode", 16

End Sub
———————————
Sub StartANSI32()
REM ANSI-Zeichensatz mit 32 Spalten

Zeichensatz "ANSI", 32

End Sub
———————————
Sub StartUnicode32()
REM Unicode-Zeichensatz mit 32 Spalten

Zeichensatz "Unicode", 32

End Sub

———————————

Sub Zeichensatz(CodeArt As String, MaxColumnNumber)

REM Erstellung der Zeichentabelle

Dim I As Long
Dim J, K As Long
Dim Zeichen As String
Rem MaxColumnNumber, MaxRowNumber jeweils nur effektiv von
Rem Zeichen genutzte Spalten/Zeilen, nicht Tabellenüberschrift
Rem und Nummerierungsspalte
Dim MaxRowNumber As Long

StartRows = 3 ' Länge der Tabelle bei Makrobeginn

Select Case CodeArt
Case "ANSI"
MaxRowNumber = (256 / MaxColumnNumber) - 1
Case "Unicode"
MaxRowNumber = (32768 / MaxColumnNumber) - 1
End Select

Documents.Add
If MaxColumnNumber = 16 Then
ActiveDocument.PageSetup.Orientation = wdOrientPortrait
Else
ActiveDocument.PageSetup.Orientation = wdOrientLandscape
End If

With Selection
.HomeKey wdStory, wdMove
.EndKey wdStory, wdExtend
.Delete
.EndKey wdStory, wdExtend
.Font.Name = "Courier New"
.Font.Size = 9
End With

ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=StartRows, NumColumns:=MaxColumnNumber + 1
' Zeilenzahl wird automatisch dem Bedarf angepaßt

With Selection
.Tables(1).Columns(1).SetWidth ColumnWidth:=38.95, RulerStyle:=wdAdjustNone
.MoveRight Unit:=wdCharacter, Count:=1
.MoveDown Unit:=wdLine, Count:=StartRows - 1, Extend:=wdExtend
.MoveRight Unit:=wdCharacter, Count:=MaxColumnNumber, Extend:=wdExtend
.ParagraphFormat.Alignment = wdAlignParagraphCenter
.MoveLeft Unit:=wdCharacter, Count:=2
.MoveDown Unit:=wdLine, Count:=StartRows - 1, Extend:=wdExtend
.ParagraphFormat.Alignment = wdAlignParagraphRight
.MoveLeft Unit:=wdCharacter, Count:=2
.Rows.HeadingFormat = wdToggle
End With

For K = 0 To (MaxColumnNumber / 16) - 1
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="0"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="1"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="2"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="3"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="4"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="5"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="6"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="7"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="8"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="9"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="a"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="b"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="c"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="d"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="e"
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:="f"
Next K

Selection.MoveRight Unit:=wdCharacter, Count:=2

Do While J = 0 ' "Künstliche" Do-Schleife, um Aussprung zu erlauben
Select Case CodeArt
' Die Ausgabe einiger Zeichen (z.B. 128, Euro)
' ist von der Art der Codierung abhängig.

Case "ANSI"
With Selection
For I = 0 To MaxRowNumber
.InsertAfter I * J
.MoveRight Unit:=wdCell
For J = 0 To MaxColumnNumber - 1
Zeichen = Chr$(I * MaxColumnNumber + J)
If (I * MaxColumnNumber + J) < 32 Then
Zeichen = "."
End If
.InsertAfter Zeichen
.MoveRight Unit:=wdCell
Next J
Next I
End With

Case "Unicode"
x = 0
With Selection
For I = 0 To MaxRowNumber
Select Case x
Case 0
If 10 * I >= MaxRowNumber Then
x = MsgBox("Fortfahren? - Dann wählen Sie 'Ja'. Es sind 10% des Makros abgearbeitet.", vbYesNo, "Fortfahren?")
If x = 7 Then
Exit Do
Else
x = MsgBox("Sie gehen jetzt, wollen nicht weiter mit Unterbrechungen geärgert werden? Dann wählen Sie 'Ja', sonst 'Nein'.", vbYesNo, "Weiterhin unterbrechen?")
If x = 6 Then
x = 99
Else
x = 1
End If
End If
End If
Case 1
If 4 * I >= MaxRowNumber Then
x = MsgBox("Fortfahren? - Dann wählen Sie 'Ja'. Es sind 25% des Makros abgearbeitet.", vbYesNo, "Fortfahren?")
If x = 7 Then
Exit Do
Else
x = 2
End If
End If
Case 2
If 2 * I >= MaxRowNumber Then
x = MsgBox("Fortfahren? - Dann wählen Sie 'Ja'. Es sind 50% des Makros abgearbeitet.", vbYesNo, "Fortfahren?")
If x = 7 Then
Exit Do
Else
x = 3
End If
End If
Case 3
If 1.34 * I >= MaxRowNumber Then
x = MsgBox("Fortfahren? - Dann wählen Sie 'Ja'. Es sind 75% des Makros abgearbeitet.", vbYesNo, "Fortfahren?")
If x = 7 Then
Exit Do
Else
x = 4
End If
End If
End Select
.InsertAfter I * J
.MoveRight Unit:=wdCell
For J = 0 To MaxColumnNumber - 1
Zeichen = ChrW$(I * MaxColumnNumber + J)
If (I * MaxColumnNumber + J) < 32 Then
Zeichen = "."
End If
.InsertAfter Zeichen
.MoveRight Unit:=wdCell
Next J
Next I
End With
End Select
Loop

With Selection
.HomeKey wdStory, wdMove
.MoveRight Unit:=wdCell
.MoveDown Unit:=wdLine
.MoveDown Unit:=wdLine, Count:=I, Extend:=wdExtend
.MoveRight Unit:=wdCharacter, Count:=MaxColumnNumber - 1, Extend:=wdExtend
.Font.Name = "Courier"
End With
End Sub

InvitationWare

Die Informationen auf www.transcom.de sind InvitationWare: Einerseits sind Sie eingeladen, sie zu nutzen. Andererseits, wenn die Informationen auf diesen Seiten Ihnen geholfen haben oder die Tipps und Programme für Sie nützlich sind, dann erinnern Sie sich doch an Transcom, wenn Sie mal wieder einen Auftrag in einem unserer (Link intern) Fachgebiete zu vergeben haben — und senden uns eine Einladung zum Angebot. (Link intern) Rufen Sie uns an oder senden uns eine E-Mail.

 

» Transcom gehört zum Verbund der media offices (www.mediaoffices.de)