emplacement enregistrement d'apres un tableau word

**keranLatos** · 11/06/2021, 14h26

Bonjour voila j'aimerais enregistrer les donner comprise dans une case dans un fichier deja existant qui porte le nom de la case d'audesus le probleme c'est que le chemin est tromper par un retour a la ligne de je ne sais ou je vous joint mon code ... merci

Code vb :

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
Sub test()
 
Dim nom
 
Dim osb1 As String
 
nom = ActiveDocument.Tables(2).Cell(Row:=1, Column:=1).Range
 
nom = Left(nom, (Len(nom) - 1))
 
osb1 = ActiveDocument.Tables(1).Cell(2, 1).Range.Text
 
 
 
 
 
 
ActiveDocument.Tables(1).Cell(2, 1).Range.Select
 
Selection.Copy
 
 
MsgBox "D:\Downloads\Ressources\Ressources\" & nom & ".docx"
 
 
ChangeFileOpenDirectory "D:\Downloads\Ressources\Ressources\" & nom & "\note\"
 
Documents.Open FileName:="observation " & nom & ".docx", ConfirmConversions:= _
 
        False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
 
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
 
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""
 
 
 
    Selection.InsertDateTime DateTimeFormat:="dddd d MMMM yyyy", InsertAsField _
 
        :=False, DateLanguage:=wdFrench, CalendarType:=wdCalendarWestern, _
 
        InsertAsFullWidth:=False
 
 
 
    Selection.TypeParagraph
 
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
 
    ActiveDocument.save
 
    ActiveWindow.Close
 
 
 
 
 
 
End Sub

Invité · 11/06/2021, 18h05

Envoyé par keranLatos

Bonjour,

Utilisez des Debug.print pour voir ce que vous récupérez dans vos variables dans la fenêtre exécution (Ctrl-G), notamment pour votre variable nom.

**keranLatos** · 11/06/2021, 19h09

problème resolu merci

**keranLatos** · 11/06/2021, 19h30

petite question penser vous que l'on peu faire une boucle un peu de ce style ?

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 obsevcopy()
Dim i As Integer
Dim f As Integer, n As Integer, t As Integer
Dim nom1, nom2, nom3, nom4, nom5, nom6, nom7, nom8, nom9, nom10, nom11, nom12, nom13, nom14, nom15, nom16, nom17, nom18, nom19, nom20, nom21
 
nom1 = ActiveDocument.Tables(2).Cell(Row:=1, Column:=1).Range
nom2 = ActiveDocument.Tables(2).Cell(Row:=3, Column:=1).Range
nom3 = ActiveDocument.Tables(2).Cell(Row:=5, Column:=1).Range
nom4 = ActiveDocument.Tables(2).Cell(Row:=7, Column:=1).Range
nom5 = ActiveDocument.Tables(2).Cell(Row:=9, Column:=1).Range
nom6 = ActiveDocument.Tables(2).Cell(Row:=11, Column:=1).Range
nom7 = ActiveDocument.Tables(2).Cell(Row:=12, Column:=1).Range
nom8 = ActiveDocument.Tables(2).Cell(Row:=15, Column:=1).Range
nom9 = ActiveDocument.Tables(2).Cell(Row:=17, Column:=1).Range
nom10 = ActiveDocument.Tables(2).Cell(Row:=19, Column:=1).Range
nom11 = ActiveDocument.Tables(2).Cell(Row:=21, Column:=1).Range
nom12 = ActiveDocument.Tables(2).Cell(Row:=23, Column:=1).Range
nom13 = ActiveDocument.Tables(2).Cell(Row:=25, Column:=1).Range
nom14 = ActiveDocument.Tables(2).Cell(Row:=27, Column:=1).Range
nom15 = ActiveDocument.Tables(2).Cell(Row:=29, Column:=1).Range
nom16 = ActiveDocument.Tables(2).Cell(Row:=31, Column:=1).Range
nom17 = ActiveDocument.Tables(2).Cell(Row:=33, Column:=1).Range
nom18 = ActiveDocument.Tables(2).Cell(Row:=35, Column:=1).Range
nom19 = ActiveDocument.Tables(2).Cell(Row:=37, Column:=1).Range
nom20 = ActiveDocument.Tables(2).Cell(Row:=39, Column:=1).Range
nom21 = ActiveDocument.Tables(2).Cell(Row:=41, Column:=1).Range
 
nom1 = Left(nom1, (Len(nom1) - 2))
nom2 = Left(nom1, (Len(nom1) - 2))
nom3 = Left(nom1, (Len(nom1) - 2))
nom4 = Left(nom1, (Len(nom1) - 2))
nom5 = Left(nom1, (Len(nom1) - 2))
nom6 = Left(nom1, (Len(nom1) - 2))
nom8 = Left(nom1, (Len(nom1) - 2))
nom9 = Left(nom1, (Len(nom1) - 2))
nom10 = Left(nom1, (Len(nom1) - 2))
nom11 = Left(nom1, (Len(nom1) - 2))
nom12 = Left(nom1, (Len(nom1) - 2))
nom13 = Left(nom1, (Len(nom1) - 2))
nom14 = Left(nom1, (Len(nom1) - 2))
nom15 = Left(nom1, (Len(nom1) - 2))
nom16 = Left(nom1, (Len(nom1) - 2))
nom17 = Left(nom1, (Len(nom1) - 2))
nom18 = Left(nom1, (Len(nom1) - 2))
nom19 = Left(nom1, (Len(nom1) - 2))
nom20 = Left(nom1, (Len(nom1) - 2))
nom21 = Left(nom1, (Len(nom1) - 2))
 
On Error Resume Next
For f = 0 To t Step 1
For i = 2 To n Step 2
ActiveDocument.Tables(2).Cell(Row:=i, Column:=1).Range.Select
Selection.Copy
 
ChangeFileOpenDirectory "D:\Downloads\Ressources\Ressources\" & nom & f & "\note\"
Documents.Open FileName:="observation " & nom & f & ".docx"
 
    Selection.InsertDateTime DateTimeFormat:="dddd d MMMM yyyy", InsertAsField _
        :=False, DateLanguage:=wdFrench, CalendarType:=wdCalendarWestern, _
        InsertAsFullWidth:=False
 
    Selection.TypeParagraph
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    ActiveDocument.save
    ActiveWindow.Close
    Next n
    Next r
 
End Sub

Invité · 13/06/2021, 07h55

Envoyé par keranLatos

petite question penser vous que l'on peu faire une boucle un peu de ce style ?

Difficile de comprendre vos boucles et a priori les variables nomXX me semblent inutiles. Ce que je comprends, c'est que vous avez des informations sur 2 lignes du tableau 2. Dans ce cas le nom peut être récupéré sans doute avec I-1.

**keranLatos** · 14/06/2021, 10h32

bonjour ,
desoler pour les variable nomXX je veux recupere les information toutes les 2 lignes et de retirer 2 caractere a chaque fois .
du coup en premier lieux recupere le nomxx puis le contenu de la ligne de desous pour sauvegarder . je ne sais pas si c'est claire mais je vais chercher

Invité · 14/06/2021, 10h39

Envoyé par keranLatos

je ne sais pas si c'est claire mais je vais chercher

Non.

Mettez des vidages d'écran ou des fichiers.

**keranLatos** · 14/06/2021, 10h53

je vous joint tous les fichier dans l'etat ou je suis la mais j'essaye de trouver par moi meme une solution je vous remerci encore !

Invité · 14/06/2021, 10h59

Envoyé par keranLatos

Joignez un format .zip.

**keranLatos** · 14/06/2021, 11h05

Voila navré

**keranLatos** · 14/06/2021, 11h20

je pense deja avoir une idee de comment faire ma boucle ^^"

Invité · 14/06/2021, 11h24

Envoyé par keranLatos

Quelque chose ne va pas dans votre code concernant la variable nom car nom est également une procédure.

**keranLatos** · 14/06/2021, 11h25

c'est possible ^^" je suis pas encore caler avec tous cela ^^"

Invité · 14/06/2021, 11h33

Envoyé par keranLatos

c'est possible ^^" je suis pas encore caler avec tous cela ^^"

Ben, c'est par cela qu'il faut commencer. Il vous faut régler tous les problèmes recensés avec le déboggueur et les traiter avant de coder.

Sinon, vous cherchez à ouvrir un document

Code :

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

1
2
 
"observation " & nom & f & ".docx"

Avez-vous un modèle ?

**keranLatos** · 14/06/2021, 11h37

d'accord je vais regarder

merci

et nom c'est un fichier qui est deja crée dans un dossier

pour l’instant je viens de faire cela et ça marche un peu mais je la boucle n'est pas encore bien regler je pense qu'en pensez vous ?

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
Sub obsevcopy()
Dim i As Integer
Dim f As Integer
Dim j As Integer
 
On Error GoTo handler
For f = 1 To 10 Step 2
For i = 2 To 12 Step 2
ActiveDocument.Tables(2).Cell(Row:=i, Column:=1).Range.Select
Selection.Copy
ChangeFileOpenDirectory "D:\Downloads\Ressources\Ressources\" & Left(ActiveDocument.Tables(2).Cell(Row:=f, Column:=1).Range, (Len(ActiveDocument.Tables(2).Cell(Row:=f, Column:=1).Range) - 2)) & "\note\"
Documents.Open FileName:="observation " & Left(ActiveDocument.Tables(2).Cell(Row:=f, Column:=1).Range, (Len(ActiveDocument.Tables(2).Cell(Row:=f, Column:=1).Range) - 2)) & ".docx"
 
    Selection.InsertDateTime DateTimeFormat:="dddd d MMMM yyyy", InsertAsField _
        :=False, DateLanguage:=wdFrench, CalendarType:=wdCalendarWestern, _
        InsertAsFullWidth:=False
 
    Selection.TypeParagraph
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    ActiveDocument.save
    ActiveWindow.Close
    Next i
    Next f
 
handler:
Exit Sub
 
End Sub

**keranLatos** · 14/06/2021, 11h49

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
Sub obsevcopy()
Dim i As Integer, f As Integer
 
On Error GoTo handler
For f = 1 To 10 Step 2
For i = 2 To 12 Step 2
 
 
If ActiveDocument.Tables(2).Cell(Row:=i, Column:=1).Range = "" Then Resume Next
 
ActiveDocument.Tables(2).Cell(Row:=i, Column:=1).Range.Select
Selection.Copy
 
ChangeFileOpenDirectory "D:\Downloads\Ressources\Ressources\" & Left(ActiveDocument.Tables(2).Cell(Row:=f, Column:=1).Range, (Len(ActiveDocument.Tables(2).Cell(Row:=f, Column:=1).Range) - 2)) & "\note\"
Documents.Open FileName:="observation " & Left(ActiveDocument.Tables(2).Cell(Row:=f, Column:=1).Range, (Len(ActiveDocument.Tables(2).Cell(Row:=f, Column:=1).Range) - 2)) & ".docx"
 
    Selection.InsertDateTime DateTimeFormat:="dddd d MMMM yyyy", InsertAsField _
        :=False, DateLanguage:=wdFrench, CalendarType:=wdCalendarWestern, _
        InsertAsFullWidth:=False
 
    Selection.TypeParagraph
    Selection.PasteAndFormat (wdFormatOriginalFormatting)
    ActiveDocument.save
    ActiveWindow.Close
 
    Next i
    Next f
 
handler:
Exit Sub
 
End Sub