[VBS Macro] Word watermerk

Pagina: 1
Acties:

Onderwerpen


Acties:
  • 0 Henk 'm!

  • josvane
  • Registratie: Oktober 2002
  • Laatst online: 09-09 13:03
Voor een klant probeer ik een macro te maken word, het is de bedoeling met 1 druk op de knop het watermerk in te stellen, dit op zich werkt als ik een opname maak in word.

Als ik nu alleen een aangepast watermerk wil voor de 1e pagina gaat het mis. Zelfs als ik een opname maak met tekst gebaseerde kopteksten gaat het mis.

Het script ziet er na opname zo uit.
VBScript:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Sub a()
'
' a Macro
'
'
    If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        ActiveWindow.Panes(2).Close
    End If
    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
        ActivePane.View.Type = wdOutlineView Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    End If
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    Selection.TypeText Text:="1e pagina"
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    Selection.TypeParagraph
    Selection.MoveDown Unit:=wdScreen, Count:=1
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        ActiveWindow.Panes(2).Close
    End If
    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
        ActivePane.View.Type = wdOutlineView Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    End If
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    Selection.TypeText Text:="2e pagina"
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub


Als ik een nieuw document open dan zet hij beide kopteksten gewoon achter elkaar. Als ik bovenstaande code ombouw met een achtergrond afb. Plaats hij er ook maar een als achtergrond.

Daarnaast vindt ik het vreemd dat als ik een opname maak een watermerk invoeg. Dat hij bij gebruik van deze VBS code geen watermerk plaats maar een afbeelding in de koptekst.

Heeft iemand hier ervaring mee hoe dit op te lossen.

De basis heb ik hier vandaan

Acties:
  • 0 Henk 'm!

  • Venxir
  • Registratie: Augustus 2001
  • Laatst online: 22:32
Ik dnek dat dit beter als basis kan zijn, laat je niet intimideren door de hoeveelheid. Het is een vrij complete set van functies(toevoegen en verwijderen). Waarschijnlijk kan je bovenin dus ook een selectie maken per pagina, ik weet de correcte methode helaas niet. :)

code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
Option Explicit 
Sub InsertWaterMark() 
    Dim strWMName As String 
     
    On Error Goto ErrHandler 
     'selects all the sheets
    ActiveDocument.Sections(1).Range.Select 
    strWMName = ActiveDocument.Sections(1).Index 
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader 
     'Change the text for your watermark here
    Selection.HeaderFooter.Shapes.AddTextEffect(msoTextEffect1, _ 
    "DRAFT", "Arial", 1, False, False, 0, 0).Select 
    With Selection.ShapeRange 
         
        .Name = strWMName 
        .TextEffect.NormalizedHeight = False 
        .Line.Visible = False 
         
        With .Fill 
             
            .Visible = True 
            .Solid 
            .ForeColor.RGB = Gray 
            .Transparency = 0.5 
        End With 
         
        .Rotation = 315 
        .LockAspectRatio = True 
        .Height = InchesToPoints(2.42) 
        .Width = InchesToPoints(6.04) 
         
        With .WrapFormat 
            .AllowOverlap = True 
            .Side = wdWrapNone 
            .Type = 3 
             
        End With 
         
        .RelativeHorizontalPosition = wdRelativeVerticalPositionMargin 
        .RelativeVerticalPosition = wdRelativeVerticalPositionMargin 
         
         'If using Word 2000 you may need to comment the 2
         'lines above and uncomment the 2 below.
         
         '        .RelativeHorizontalPosition = wdRelativeVerticalPositionPage
         '        .RelativeVerticalPosition = wdRelativeVerticalPositionPage
         
        .Left = wdShapeCenter 
        .Top = wdShapeCenter 
    End With 
     
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument 
     
    Exit Sub 
     
ErrHandler: 
    MsgBox "An error occured trying to insert the watermark." & Chr(13) & _ 
    "Error Number: " & Err.Number & Chr(13) & _ 
    "Decription: " & Err.Description, vbOKOnly + vbCritical, "Error" 
     
     
End Sub 
 
 
Sub RemoveWaterMark() 
    Dim strWMName As String 
     
    On Error Goto ErrHandler 
     
    ActiveDocument.Sections(1).Range.Select 
    strWMName = ActiveDocument.Sections(1).Index 
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader 
    Selection.HeaderFooter.Shapes(strWMName).Select 
    Selection.Delete 
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument 
     
    Exit Sub 
     
     
ErrHandler: 
    MsgBox "An error occured trying to remove the watermark." & Chr(13) & _ 
    "Error Number: " & Err.Number & Chr(13) & _ 
    "Decription: " & Err.Description, vbOKOnly + vbCritical, "Error" 
     
End Sub


Bron: http://www.vbaexpress.com/kb/getarticle.php?kb_id=588

If it aint broke, fix it till it is!


Acties:
  • 0 Henk 'm!

  • Reptile209
  • Registratie: Juni 2001
  • Laatst online: 01:06

Reptile209

- gers -

Ik heb zo'n donkerbruin vermoeden dat je je wat meer moet gaan inlezen in VBA voordat je je produkt aan klanten gaat verkopen :).

Je opgenomen macro staat nog vol met rommel. Daarnaast mis je volgens mij het deel waarin je instelt dat je twee secties hebt, en dat header en footer voor sectie 1 en 2 niet gekoppeld zijn. En dan komt er in een nieuw document inderdaad geen automagische section break, en dus krijg je alle kopteksten bij elkaar.
Kortom: je hebt maar een deel van het werk opgenomen met je macro.

Volgens mij gebruikt Word de header/footer ook voor watermarks, dus het is niet heel vreemd dat je afbeelding in eerste instantie daar terecht komt. Je macro moet het plaatje dan netjes positioneren.

Verdiep je eens even wat meer in wat je wil bereiken en ga daar mee aan de slag. Daar leer je ook meer van dan nu te gaan rommelen met een bijna kant-en-klare oplossing zoals die van Venxir.

Zo scherp als een voetbal!


Acties:
  • 0 Henk 'm!

  • NMe
  • Registratie: Februari 2004
  • Laatst online: 09-09 13:58

NMe

Quia Ego Sic Dico.

Hoe vaak wilde je nog op onze stickies gewezen worden? :? Waar hoort mijn topic?

PRG>>OFF

'E's fighting in there!' he stuttered, grabbing the captain's arm.
'All by himself?' said the captain.
'No, with everyone!' shouted Nobby, hopping from one foot to the other.