Discussion :

[nadyves]

Bonjour,

Je vous expose mon petit problème.

Pour gérer des demandes d’essai, j’ai un log, que j’appelle « Log_Demande_Essai », duquel j’accède à un classeur appelé « Vierge ».
J’enregistre des demandes d’essai et cela incrémente un numéro d’enregistrement (valeur numérique) dans mon log. Là pas de problème.
Puis, je suis amené à modifier ma fiche demande d’essai (anciennement Vierge) et quand je valide la modification, cela modifie la première ligne comptent la valeur du numéro d’enregistrement.
Exemple : dans le log, il y a 44 numéros d’enregistrement et si je veux modifier le numéro 4, il me prend le numéro 44.

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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
Sub Enregistrement()
'
'Enregistrer une nouvelle Demande d'essai
'Macro créé par Y. Dehlinger le 17-02-2012
'
 
'
    If Workbooks("Vierge.xls").Sheets("Demande_Essai").Range("K10").Value = "" Then Exit Sub
 
    Workbooks("Log_Demande_Essai.xls").Activate
    Sheets("Log").Rows("9:9").Select
    Selection.Insert Shift:=xlDown
    Sheets("Log").Range("A9").Select
 
    Workbooks("Vierge.xls").Activate
    Sheets("Demande_Essai").Range("P2:AF2").Select
    Selection.Copy
    Workbooks("Log_Demande_Essai.xls").Sheets("Log").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Workbooks("Vierge.xls").Activate
    Sheets("Demande_Essai").Range("P2").Select
    Selection.ClearContents
    Workbooks("Log_Demande_Essai.xls").Sheets("Log").Activate
    Sheets("Log").Range("A9").Select
    Selection.Copy
    Workbooks("Vierge.xls").Activate
    Sheets("Demande_Essai").Range("P2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
    ActiveSheet.Shapes.Range(Array("Rectangle à coins arrondis 1")).Select
    Selection.Delete
    Sheets("Demande_Essai").Range("M8:M12").Select
    Selection.ClearContents
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Sheets("Demande_Essai").Range("C10").Select
 
    date_now = Workbooks("Vierge.xls").Sheets("Demande_Essai").Range("J10").Value
    n° = Workbooks("Vierge.xls").Sheets("Demande_Essai").Range("K10").Value
    nomfich = "DE" & " n°" & date_now & n° & ".xls"
    ActiveWorkbook.SaveAs Filename:="I:\Qualit.M.-Techn. Supp\Demande_Essai\Archive_Demande_Essai\" & nomfich, FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
 
    Workbooks("Log_Demande_Essai.xls").Sheets("Log").Activate
    ActiveSheet.Range("C9").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="I:\Qualit.M.-Techn. Supp\Demande_Essai\Archive_Demande_Essai\" & nomfich
 
    ActiveWorkbook.Save
 
    Workbooks(nomfich).Activate
 
    ActiveWorkbook.Close savechanges:=True
 
 
End Sub
 
Sub Modification()
'
'Modifier la demande d'essai
'Macro créé par Y. Dehlinger le 17-02-2012
'
 
'
 
    n°enr = Range("P2")
 
    Sheets("Demande_Essai").Range("P2:AF2").Select
    Selection.Copy
    Workbooks("Log_Demande_Essai.xls").Sheets("Log").Activate
    Sheets("Log").Columns("A:A").Select
    Selection.Find(What:=n°enr, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
    ActiveWorkbook.Save
 
    ActiveWorkbook.Close savechanges:=True
    ActiveWorkbook.Close savechanges:=True
 
 
End Sub

Merci pour votre aide

[gFZT82]

Bonjour,

Sans entrer dans le détail de ton code, tu peux essayer en utilisant le paramètre LookAt:=xlWhole de la méthode Find afin de rechercher une correspondance avec l'ensemble du texte recherché .

Code :

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

1
2
3
    Selection.Find(What:=n°enr, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Select

Cordialement.

[nadyves]

Bonjour,
Un grand merci à gFZT82, finalement c'était très simple