Discussion :

[EzkroO]

Bonjour à tous,

Etant une grosse grosse grosse nullité en terme de macro, je vous supplie de m'aider svp.
je présente mon problème :

je reçois des plans de constructions que je dois transférer chez un sous-traitants. Pour ne pas me faire voler mes clients, je masque (biffe) les informations contenues dans les documents avec pour l'instant le meilleur outil en ma possession, le fameux rouleau de blanc.
J'imagine qu'il existe aujourd'hui des moyens informatiques qui permettent de faire la même chose. j'ai déjà essayé de nombreuses fois mais mes compétences en informatiques s’arrêtent la!
j'ai importé les plans dans un document word et je pensais pouvoir inclure une forme automatique devant les infos à masquer et la répéter sur les autres pages mais que neni, ce diable de word ne veux rien savoir.
Si je copie colle la forme automatique, elle ne se replace pas au même endroit! j'ai essayé de passer par l'en tête mais pas ce n'est pas mieux! j'ai trouvé cette macro sur le net mais malheureusement pour moi la zone de texte est transparente et je ne peux m'en servir de biffe.
Les informations que je dois masquer sur mes plans sont incluent dans le cartouche et sont situées exactement au même endroit d'une page à l'autre. En fait je pense que la manipulation est très simple mais je n'ai pas trouvé, du coup je sollicite votre aide

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub zdt()
Dim zdt As Shape, nombre
Selection.HomeKey Unit:=wdStory
nombre = Selection.Information(wdNumberOfPagesInDocument)
nombre2 = 1
Do While nombre2 < nombre
nombre2 = Selection.Information(wdActiveEndPageNumber)
Set zdt = ActiveDocument.Shapes.AddTextbox _
(Orientation:=msoTextOrientationHorizontal, _
Left:=13, Top:=750, Width:=95, Height:=65)
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=1
Loop
End Sub

Si quelqu'un peux me donner un axe d'amélioration ou une idée pour parvenir à mes fins, je suis preneur!
Si en plus cette personne me transmet une macro déjà terminée, je signe.
D'avance merci!

Cordialement,

[Invité]

Bonjour,

Essayez ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub zdt()
 
Dim zdt As Shape
Dim Nombre As Integer, Nombre2 As Integer
Dim DocEnCours As Document
 
    Set DocEnCours = ActiveDocument
    With DocEnCours
         Selection.HomeKey Unit:=wdStory
         Nombre = Selection.Information(wdNumberOfPagesInDocument)
         Nombre2 = 1
         Do While Nombre2 < Nombre
            Nombre2 = Selection.Information(wdActiveEndPageNumber)
            Set zdt = ActiveDocument.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=13, Top:=750, Width:=95, Height:=65)
            With zdt.Fill
                 .Visible = msoTrue
                 .ForeColor.ObjectThemeColor = msoThemeColorBackground1
                 .ForeColor.TintAndShade = 0
                 .ForeColor.Brightness = 0
                 .Transparency = 0
                 .Solid
            End With
            Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=1
            Set zdt = Nothing
        Loop
 
    End With
    Set DocEnCours = Nothing
 
End Sub

• Si vous postez du code, sélectionnez-le et cochez la balise # pour avoir l'aspect ci-dessus.
• Si vous souhaitez modifier les paramètres de la forme, faites l'essai sur Excel avec une forme équivalente et regardez les paramètres qui auront changé.

[EzkroO]

Tout d'abord merci de votre réponse rapide
Je test la nouvelle macro de suite et je vous tiens au courant.
Encore merci,

Cdlt

[EzkroO]

Tout marche du tonnerre, par contre, existerait-il la possibilité de positionner la biffure avec une unité de mesure autre que le pixel.

D'avance merci
Cdlt

[Invité]

A adapter :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
Dim HauteurEnCm As Single, HauteurEnPoints As Single, LongueurEnCm As Single, LongueurEnPoints As Single
Dim GaucheEnCm As Single, GaucheEnPoints As Single, HautEnCm As Single, HautEnPoints As Single
 
    GaucheEnCm = 1
    HautEnCm = 23
    HauteurEnCm = 3
    LongueurEnCm = 5
 
    GaucheEnPoints = GaucheEnCm / 2.55 * 72
    HautEnPoints = HautEnCm / 2.55 * 72
    HauteurEnPoints = HauteurEnCm / 2.55 * 72
    LongueurEnPoints = LongueurEnCm / 2.55 * 72
 
  ' ......
 
     Set zdt = ActiveDocument.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, Left:=GaucheEnPoints, Top:=HautEnPoints, Width:=LongueurEnPoints, Height:=HauteurEnPoints)

[EzkroO]

Je test ça cette après midi, je vous tiens au courant!

Encore un grand merci pour votre aide et franchement, chapeau bas l'artiste!