Discussion :

[roby68]

Bonjour le Forum

J'aimerai effectuer à partir d'un modèle de document effectuer 2 sauvegardes indépendantes avec une touche de raccourci ( exemple Ctrl + R ).

La 1ere copie de sauvegarde ( document entier ) dans un répertoire défini. Cà, je sais faire.
La particularité de la 2ème copie de sauvegarde ( la 1ère page seulement ) dans un autre répertoire défini.

je ne trouve pas le code.

merci de votre aide.

Roby

[Invité]

Bonjour,

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
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
 
Sub SauvegarderLaPage1()
 
Dim DocEnCours As Document, DocCible As Document
Dim RepertoireCible As String
Dim I As Integer
 
 
    Set DocEnCours = ActiveDocument
    With DocEnCours
         RepertoireCible = .Path & "\Dossier copies\"
         .Range.Copy
    End With
 
    Set DocCible = Documents.Add
 
    With DocCible
         .Range.Paste
         For I = .Paragraphs.Count To 1 Step -1
             With .Paragraphs(I).Range
                  If .Information(wdActiveEndPageNumber) > 1 Then .Delete
             End With
         Next I
 
         .SaveAs RepertoireCible & DocEnCours.Name
         .Close
 
    End With
 
    Set DocCible = Nothing
    Set DocEnCours = Nothing
 
End Sub

[roby68]

bonjour le Forum, Eric KERGRESSE

j'ai adapté ton code, mais une erreur au niveau de la ligne suivante :

If .Information(wdActiveEndPageNumber) > 1 Then .Delete

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
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
 
Sub Enregistrer()
Dim MonDoc1, MonDoc1b, MonDoc2, MonDoc3
Dim MonFichier As String
Dim Chemin2 As String
Dim NU As String
NU = Environ("USERNAME")
If NU = "toto" Or NU = "toto" Or NU = "Roby" Then
    NU = "RB"
End If
If NU = " " Or NU = " " Then
    NU = "PS"
End If
If NU = " " Or NU = " " Then
    NU = "TB"
End If
If NU = " " Or NU = " " Then
    NU = "ER"
End If
If NU = " " Or NU = " " Then
    NU = "MR"
End If
Chemin = ActiveDocument.Path & Application.PathSeparator
Chemin2 = "D:\roby\Dossier-RB\XX - Archives PSE\4 - Dossier ( Tableau )\"
MonDoc1 = Format(Date, "yyyy") & "-" & Format(Date, "mm") & "-" & Format(Date, "dd") & "  " & Format(Time, "hhmm") & " ( " & NU & " ) " & ActiveDocument.Bookmarks("PPSMJ1").Range.Text & ".docm"
If Left(ActiveDocument.Bookmarks("PPSMJ1").Range.Text, 2) = "M." Then
    VPPSMJ = ActiveDocument.Bookmarks("PPSMJ1").Range.Text
    VPPSMJ = Replace(VPPSMJ, "M. ", "", 1, 1, 1)
    MonDoc1b = VPPSMJ & " " & Format(Date, "yyyy") & "-" & Format(Date, "mm") & "-" & Format(Date, "dd") & "  " & Format(Time, "hhmm") & " ( " & NU & " ) " & ".docm"
End If
If Left(ActiveDocument.Bookmarks("PPSMJ1").Range.Text, 3) = "Mme" Then
    VPPSMJ = ActiveDocument.Bookmarks("PPSMJ1").Range.Text
    VPPSMJ = Replace(VPPSMJ, "Mme ", "", 1, 1, 1)
    MonDoc1b = VPPSMJ & " " & Format(Date, "yyyy") & "-" & Format(Date, "mm") & "-" & Format(Date, "dd") & "  " & Format(Time, "hhmm") & " ( " & NU & " ) " & ".docm"
End If
MonDoc2 = Chemin2 & MonDoc1b
MonDoc3 = Chemin & MonDoc1b
NU = Environ("USERNAME")
If NU = "" Or NU = "" Or NU = "Roby" Then
    ActiveDocument.SaveAs FileName:=MonDoc2
End If
'***********************************************
Dim DocEnCours As Document, DocCible As Document
Dim RepertoireCible As String
Dim I As Integer
    Set DocEnCours = ActiveDocument
    With DocEnCours
'         RepertoireCible = .Path & "\Dossier copies\"
         RepertoireCible = .Path & "\"
         .Range.Copy
    End With
    Set DocCible = Documents.Add
    With DocCible
         .Range.Paste
         For I = .Paragraphs.Count To 1 Step -1
             With .Paragraphs(I).Range
                  If .Information(wdActiveEndPageNumber) > 1 Then .Delete
             End With
         Next I
'         .SaveAs RepertoireCible & DocEnCours.Name
         .SaveAs MonDoc3
         .Close
     End With
     Set DocCible = Nothing
    Set DocEnCours = Nothing
'***********************************************
'ActiveDocument.SaveAs FileName:=MonDoc3
Application.Quit (wdDoNotSaveChanges)
End Sub

merci encore à toi

Précisions complémentaire car je vois que ce n'est pas si évident.
Pour mon cas, le document est structuré de la façon suivante ( je travaille avec des signets sur les 2 pages voir plus ) :
La 1ère page comporte des paragraphes et des tableaux et à partir de la 2ème page ce n'est essentiellement que des paragraphes ( texte ).
- Pourrait-on si c'est plus simple, d'effacer à partir d'un mot ou d'un texte court contenu dans la 1ère page.

bonne journée à tous
Roby

[Invité]

Bonjour,

Remplacez pour voir cette ligne par :

Code :

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

1
2
 
If .Information(3) > 1 Then .Delete

Regardez l'aide ici : https://docs.microsoft.com/fr-fr/off....wdinformation

[roby68]

Le Forum, Eric KERGRESSE

affiche l'erreur : 5904 impossible d'éditer la page

par contre il a effacer mon texte mais sur la première page il m'a tout décaler les interlignes.
copie écran de mon doc ( normal )

[Invité]

Si votre document est basé sur des tableaux, il faut supprimer les lignes des tableaux et pas les paragraphes qui les composent.
Mettez un exemple non confidentiel en ligne comprenant plusieurs pages et dites-moi ce qui doit rester.

[roby68]

Si votre document est basé sur des tableaux, il faut supprimer les lignes des tableaux et pas les paragraphes qui les composent.
Mettez un exemple non confidentiel en ligne comprenant plusieurs pages et dites-moi ce qui doit rester.

Le document est un document type et je ne peux pas le modifier, il doit comporter des paragraphes et deux tableaux.
Je ne veux garder que la première page dans la 2ème sauvegarde.

[Invité]

Il ne s'agit de modifier votre document mais de voir quel code est à lui appliquer. Modéliser un document qui ne correspondrait pas à votre modèle occasionnerait de nombreux messages.
Ce n'est pas grave si vous ne pouvez pas, regardez dans le tuto VBA Word d'Oivier LEBEAU la façon de manipuler des tableaux.