Druckausgabe mit Formatierungszeichen
Hans-Ulrich Krüger
ich verwende Word 2000 und moechte eine Formatvorlage einschliesslich
aller Formatierungszeichen (Tabs, Zeilenumbrueche usw.) drucken.
Hat jemand einen Tip, wie das gehen koennte?
Vielen Dank im Voraus.
H.-U. Krueger
Lisa Wilke-Thissen
vermute, du meinst nicht Format- sondern Dokumentvorlage?
Funktioniert, indem du mit der Druck-Taste oder Alt+Druck
eine Bildschirmfotografie machst, diese per Strg+V in
ein Dokument einfügst und ausdruckst.
Alternative: an den Tab-, Absatz-, Zeilenwechselpositionen vorübergehend
die entsprechenden Sonderzeichen (Einfügen/Sonderzeichen) einfügen
und ausdrucken.
Gruß Lisa
"Hans-Ulrich Krüger" <Hans-Ulri...@t-online.de> schrieb
Thomas Löwe [MS MVP Word]
"Hans-Ulrich Krüger" <Hans-Ulri...@t-online.de>
Bezug: news:3bb601f7...@news.btx.dtag.de...
> ich verwende Word 2000 und moechte eine Formatvorlage
> einschliesslich aller Formatierungszeichen (Tabs, Zeilen-
> umbrueche usw.) drucken.
eine Möglichkeit wäre, unter "Extra, Optionen" auf der Registerkarte
"Ansicht" die Anzeige aller nicht druckbaren Zeichen (Formatierungs-
zeichen - Microsoft Word 2000) zu aktivieren und anschließend über
"Druck" ein Abbild des Bildschirminhaltes zu erstellen dieses in neues
Dokument einzufügen und dieses Dokument dann auf einem Drucker
auszugeben.
Bei weiteren Fragen stehen wir dir jederzeit gern zur Verfügung.
--
Mit freundlichen Grüßen,
Thomas Löwe [Microsoft MVP Word]
Bitte alle Supportanfragen in die Newsgroup stellen.
Microsoft KB: englisch: http://search.support.microsoft.com/kb/c.asp
Microsoft KB: deutsch : http://search.microsoft.com/germany/supportkb
Cindy Meister -WordMVP-
> ich verwende Word 2000 und moechte eine Formatvorlage einschliesslich
> aller Formatierungszeichen (Tabs, Zeilenumbrueche usw.) drucken.
>
Unter meiner Unterschrift steht ein (ziemlich langes) Makro, das einige
dieser Zeichen mit Sonderzeichen + Leerraum ersetzt. Nur ersetzen
eignet sich nicht, wenn das Dokument Layout beibehalten werden soll...
Cindy Meister
INTER-Solutions, Switzerland
http://www.mvps.org/word
http://homepage.swissonline.ch/cindymeister
http://go.compuserve.com/MSOfficeForum
Rückfragen & Antworten nur in der Newsgroup, bitte!
Sub NichtDruckbareZeichenErsetzen()
Dim rng As Word.Range
Application.ScreenUpdating = False
'Ursprünglichen Text speichern
ActiveDocument.Save
'allgemeine Suchen/Ersetzen Einstellungen vornehmen
With Selection.Find
.ClearFormatting
.Forward = True
.MatchWildcards = False
.MatchCase = False
.MatchSoundsLike = False
.Text = ""
With .Replacement
.ClearFormatting
End With
.Execute
End With
'Durch alle Dokumentteile schleifen
For Each rng In ActiveDocument.StoryRanges
Dim styType As Long
If styType <> rng.StoryType Then
ZeichenImStoryErsetzen rng, " in "
Do While Not rng.NextStoryRange Is Nothing
ZeichenImStoryErsetzen rng, " in weiteren "
Loop
End If
styType = rng.StoryType
Next rng
ActiveDocument.SaveAs FileName:=ActiveDocument.Path & _
"\Druck.doc", AddToREcentFiles:=False
ActiveDocument.PrintPreview
End Sub
Sub ZeichenImStoryErsetzen(rng As Word.Range, szMeldung As String)
Dim szGanzeMeldung As String
szGanzeMeldung = szMeldung & GetStoryType(rng.StoryType) _
& " werden bearbeitet. Bitte warten!"
Application.StatusBar = "Seitenumbrüche" & szGanzeMeldung
SeitenumbruecheErsetzen rng
Application.StatusBar = "Absatzmarken" & szGanzeMeldung
AbsatzmarkeErsetzen rng, rng.StoryType
Application.StatusBar = "Leerschläge" & szGanzeMeldung
LeerschlagErsetzen rng
Application.StatusBar = "Tabstopps" & szGanzeMeldung
TabzeichenErsetzen rng
End Sub
Sub LeerschlagErsetzen(rng As Word.Range)
Dim bGefunden As Boolean
Dim rngSuchen As Word.Range
Dim szSuchText As String
Set rngSuchen = rng.Duplicate
szSuchText = " "
Do
bGefunden = TextFinden(szSuchText, rngSuchen)
If bGefunden Then
LeerschlagBearbeiten rngSuchen
If rngSuchen.Information(wdWithInTable) Then
'Tabellen müssen anders durchsucht werden
Dim bTblGefunden As Boolean
'Zuerst gegenwärtige Zelle fertig bearbeiten
Do
rngSuchen.Collapse wdCollapseEnd
rngSuchen.End = rngSuchen.Cells(1).Range.End - 1
bTblGefunden = TextFinden(szSuchText, rngSuchen)
If bTblGefunden Then
LeerschlagBearbeiten rngSuchen
End If
Loop While bTblGefunden
TabellenSuchbereichErweitern rng, rngSuchen
Else
rngSuchen.Start = rngSuchen.End
rngSuchen.End = rng.End
End If
End If
Loop While bGefunden
End Sub
Sub TabzeichenErsetzen(ByVal rng As Word.Range)
Dim rngSuchen As Word.Range
Dim szSuchText As String
Dim bGefunden As Boolean
Set rngSuchen = rng.Duplicate
szSuchText = "^t"
Do
bGefunden = TextFinden(szSuchText, rngSuchen)
If bGefunden Then
TabzeichenBearbeiten rngSuchen
If rngSuchen.Information(wdWithInTable) Then
'Tabellen müssen anders durchsucht werden
Dim bTblGefunden As Boolean
'Zuerst gegenwärtige Zelle fertig bearbeiten
Do
'Suchbereich beginnt NACH dem Tabzeichen
rngSuchen.Start = rngSuchen.End + 1
rngSuchen.End = rngSuchen.Cells(1).Range.End - 1
bTblGefunden = TextFinden(szSuchText, rngSuchen)
If bTblGefunden Then
TabzeichenBearbeiten rngSuchen
End If
Loop While bTblGefunden
TabellenSuchbereichErweitern rng, rngSuchen
Else
rngSuchen.Start = rngSuchen.End + 1
rngSuchen.End = rng.End
End If
End If
Loop While bGefunden
End Sub
Sub AbsatzmarkeErsetzen(ByVal rng As Word.Range, ByVal styType As Long)
Dim rngSuchen As Word.Range
Set rngSuchen = rng.Duplicate
With rngSuchen.Find
.Text = "^p"
.Wrap = wdFindStop
With .Replacement
.ClearFormatting
.Text = "^0182^p"
End With
.Execute Replace:=wdReplaceAll
End With
Select Case styType
'Letzte Absatzmarke kann in Fuss- bzw. Endnoten nicht gelöscht
werden
Case 2, 3
rng.Characters(rng.Characters.Count - 1).Delete
Case Else
rng.Paragraphs.Last.Range.Delete
End Select
End Sub
Sub SeitenumbruecheErsetzen(ByVal rng)
Dim rngSuchen As Word.Range
Set rngSuchen = rng.Duplicate
With rngSuchen.Find
.Text = "^m"
.Wrap = wdFindStop
With .Replacement
.ClearFormatting
.Text = "---Seitenumbruch---^m"
End With
.Execute Replace:=wdReplaceAll
End With
End Sub
Function GetStoryType(ByVal sty As Long) As String
Select Case sty
Case 1
GetStoryType = "Hauptdokumentteil"
Case 2, 3
GetStoryType = "Fuss- und Endnoten"
Case 4
GetStoryType = "Kommentaren"
Case 5
GetStoryType = "Zeichenobjekten"
Case 6, 7, 8, 9, 10, 11
GetStoryType = "Kopf- und Fusszeilen"
Case Else
GetStoryType = "unbekannten Teil"
End Select
End Function
Function TextFinden(ByVal szSuchText As String, _
ByRef rngSuchen As Word.Range) As Boolean
With rngSuchen.Find
.Text = szSuchText
.Wrap = wdFindStop
.Execute
TextFinden = .Found
End With
End Function
Sub TabellenSuchbereichErweitern(ByVal rng As Word.Range, _
ByRef rngSuchen As Word.Range)
Dim tbl As Word.Table
Set tbl = rngSuchen.Tables(1)
'Zur nächsten Zelle, wenn nicht die letzte
If rngSuchen.Cells(1).Range <> _
tbl.Range.Cells(tbl.Range.Cells.Count).Range Then
Set rngSuchen = rngSuchen.Cells(1).Next.Range
Else
'Sonst Bereich nach der Tabelle setzen
Set rngSuchen = tbl.Range
rngSuchen.Collapse wdCollapseEnd
rngSuchen.End = rng.End
End If
End Sub
Function LeerschlagBearbeiten(ByVal rngSuchen)
Dim rngSymbol As Word.Range
'Leerräume müssen beibehalten werden, sonst kann
'der Text nicht korrekt umbrechen, also möglichst klein formatieren
Set rngSymbol = rngSuchen.Duplicate
rngSuchen.Font.Size = 1
rngSymbol.Collapse wdCollapseStart
rngSymbol.Text = Chr(149)
If rngSymbol.Font.Size >= 1.5 Then
'Entspricht etwa der Grösse des Formatzeichens
rngSymbol.Font.Size = 0.6 * rngSymbol.Font.Size
Else
rngSymbol.Font.Size = 1
End If
End Function
Function TabzeichenBearbeiten(ByVal rngSuchen As Word.Range)
Dim rng As Word.Range
Dim lTabPosition
'Position des nach dem Tabzeichen folgenden Texts festhalten
Set rng = rngSuchen.Duplicate
rng.Collapse wdCollapseEnd
lTabPosition = rng.Information( _
wdHorizontalPositionRelativeToTextBoundary)
'Pfeilsymbol vor Tabzeichen einfügen
rngSuchen.Collapse wdCollapseStart
rngSuchen.Text = Chr(142)
rngSuchen.Font.Name = "Wingdings 3"
'Grundschriftgrösse des Absatzes (für den Fall, der Tab folgt einen
Leerraum)
rngSuchen.Font.Size = rng.Font.Size
'''Alternate symbols: ChrW(8594) with normal text
'''Chr(217) with "Monotype Sorts"
'Schriftgrösse wenn nötig verkleinern, so dass
'der folgende Text an der richtigen Stelle liegt
Do While rng.Information( _
wdHorizontalPositionRelativeToTextBoundary) > lTabPosition _
And rngSuchen.Font.Size >= 1
rngSuchen.Font.Size = rngSuchen.Font.Size - 0.5
Loop
End Function
Hans-Ulrich Krüger
=?iso-8859-1?Q?Thomas_L=F6we_=5BMS_MVP_Word=5D?=
<suppor...@young-world.com> wrote:
Hallo Thomas,
> über "Druck" ein Abbild des Bildschirminhaltes zu erstellen dieses in neues
>Dokument einzufügen und dieses Dokument dann auf einem Drucker
>auszugeben.
Geht leider nicht, da ich scrollen muss,um die ganze Vorlage zu sehen.
Habe Tip von Lisa verwendet.
Trotzdem vielen Dank.
MfG
H.-U. Krueger
Hans-Ulrich Krüger
<wilke-...@t-online.de> wrote:
Hallo Lisa,
>vermute, du meinst nicht Format- sondern Dokumentvorlage?
richtig
>Alternative: an den Tab-, Absatz-, Zeilenwechselpositionen vorübergehend
>die entsprechenden Sonderzeichen (Einfügen/Sonderzeichen) einfügen
>und ausdrucken.
Druck-Taste geht nicht, da gescrollt werden muss, um die ganze Vorlage
zu sehen;
Habe Deine Alternative verwendet. Ist zwar etwas aufwendig,
funktioniert aber.
Vielen Dank
MfG
H.-U. Krueger
Hans-Ulrich Krüger
<CindyM...@swissonline.ch> wrote:
Hallo Cindy,
>Unter meiner Unterschrift steht ein (ziemlich langes) Makro, das einige
>dieser Zeichen mit Sonderzeichen + Leerraum ersetzt. Nur ersetzen
>eignet sich nicht, wenn das Dokument Layout beibehalten werden soll...
Stimmt. Werde es aber trotzdem mal ausprobieren.
Vielen Dank.
MfG
H.-U. Krueger