Simplifier mon code ?

**hdisnice** · 28/06/2011, 17h00

Bonjour,

Encore moi... après vos aides.
j'ai fais ce code, je suis un novice complet en vba !
donc désolé d'avance pour mes erreurs...

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
 
Private Sub CommandButton2_Click()
 
 
pmcopie = Application.WorksheetFunction.VLookup(Range("B3").Value, Sheets("Liste").Range("A2:L51"), 9, 0)
pmdate = Application.WorksheetFunction.VLookup(Range("B3").Value, Sheets("Liste").Range("A2:L51"), 11, 0)
pmjustif = Application.WorksheetFunction.VLookup(Range("B3").Value, Sheets("Liste").Range("A2:L51"), 12, 0)
pment = Application.WorksheetFunction.VLookup(Range("B3").Value, Sheets("Liste").Range("A2:L51"), 2, 0)
 
If pmcopie = "o" Then
    Monfichier = Application.WorksheetFunction.VLookup(Range("B3").Value, Sheets("Liste").Range("A2:L51"), 10, 0)
    Rep = "Z:\Suivi dossiers PM-LS\Dossiers PP\"
    Set wb = Workbooks.Open(Filename:=Rep & Monfichier)
 
        If wb.ReadOnly Then
        MsgBox "Fichier" & Monfichier & " déjà ouvert !"
        wb.Close False
        Else
 
Dim NewLig As Long
Dim Sh As Worksheet
Set Sh = Workbooks("Teste Pochette dossier PM.xlsm").Sheets("Mutual.")
 
With Workbooks(Monfichier).Sheets("2011c")
    NewLig = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    If NewLig < 20 Then NewLig = 20
 
    If pment = "101" Then
    .Range("A" & NewLig).Value = Sh.Range("F1").Value
    .Range("B" & NewLig).Value = Sh.Range("C10").Value
    .Range("C" & NewLig).Value = IIf(Val(Sh.Range("B13").Value) <> 0, Sh.Range("B13").Value, "")
    .Range("D" & NewLig).Value = IIf(Val(Sh.Range("B14").Value) <> 0, Sh.Range("B14").Value, "")
    .Range("E" & NewLig).Value = IIf(Val(Sh.Range("D19").Value) <> 0, Sh.Range("D19").Value, "")
    .Range("G" & NewLig).Value = IIf(Val(Sh.Range("E19").Value) <> 0, Sh.Range("E19").Value, "")
    .Range("K" & NewLig).Value = IIf(Val(Sh.Range("G19").Value) <> 0, Sh.Range("G19").Value, "")
    .Range("L" & NewLig).Value = IIf(Val(Sh.Range("F19").Value) <> 0, Sh.Range("F19").Value, "")
    .Range("M" & NewLig).Value = IIf((Sh.Range("H33").Value) = "x" Or (Sh.Range("H33").Value) = "X", "F", Workbooks(Monfichier).Sheets("2011c").Range("M" & NewLig).Value)
    .Range("M" & NewLig).Value = IIf((Sh.Range("H34").Value) = "x" Or (Sh.Range("H34").Value) = "X", "R", Workbooks(Monfichier).Sheets("2011c").Range("M" & NewLig).Value)
    .Range("M" & NewLig).Value = IIf((Sh.Range("H35").Value) = "x" Or (Sh.Range("H35").Value) = "X", "E", Workbooks(Monfichier).Sheets("2011c").Range("M" & NewLig).Value)
    .Range("S" & NewLig).Value = "Accepté"
    .Range("U" & NewLig).Value = IIf((Sh.Range("D36").Value) = "x" Or (Sh.Range("D36").Value) = "X", "", "x")
    .Range("V" & NewLig).Value = IIf((Sh.Range("D35").Value) = "x" Or (Sh.Range("D35").Value) = "X", "", "x")
    .Range("X" & NewLig).Value = IIf((Sh.Range("D37").Value) = "x" Or (Sh.Range("D37").Value) = "X", "", "x")
    .Range("Y" & NewLig).Value = IIf((Sh.Range("D38").Value) = "x" Or (Sh.Range("D38").Value) = "X", "", "x")
 
    ElseIf pment <> "101" And pmdate = "n" And pmjustif = "0" Then
    .Range("A" & NewLig).Value = Sh.Range("F1").Value
    .Range("B" & NewLig).Value = Sh.Range("C10").Value
    .Range("C" & NewLig).Value = IIf(Val(Sh.Range("D19").Value) <> 0, Sh.Range("D19").Value, "")
    .Range("E" & NewLig).Value = IIf(Val(Sh.Range("E19").Value) <> 0, Sh.Range("E19").Value, "")
    .Range("I" & NewLig).Value = IIf(Val(Sh.Range("G19").Value) <> 0, Sh.Range("G19").Value, "")
    .Range("J" & NewLig).Value = IIf(Val(Sh.Range("F19").Value) <> 0, Sh.Range("F19").Value, "")
    .Range("K" & NewLig).Value = IIf((Sh.Range("H33").Value) = "x" Or (Sh.Range("H33").Value) = "X", "F", Workbooks(Monfichier).Sheets("2011c").Range("M" & NewLig).Value)
    .Range("K" & NewLig).Value = IIf((Sh.Range("H34").Value) = "x" Or (Sh.Range("H34").Value) = "X", "R", Workbooks(Monfichier).Sheets("2011c").Range("M" & NewLig).Value)
    .Range("K" & NewLig).Value = IIf((Sh.Range("H35").Value) = "x" Or (Sh.Range("H35").Value) = "X", "E", Workbooks(Monfichier).Sheets("2011c").Range("M" & NewLig).Value)
    .Range("N" & NewLig).Value = "Accepté"
    .Range("P" & NewLig).Value = IIf((Sh.Range("D36").Value) = "x" Or (Sh.Range("D36").Value) = "X", "", "x")
    .Range("Q" & NewLig).Value = IIf((Sh.Range("D35").Value) = "x" Or (Sh.Range("D35").Value) = "X", "", "x")
    .Range("S" & NewLig).Value = IIf((Sh.Range("D37").Value) = "x" Or (Sh.Range("D37").Value) = "X", "", "x")
    .Range("T" & NewLig).Value = IIf((Sh.Range("D38").Value) = "x" Or (Sh.Range("D38").Value) = "X", "", "x")
 
    Else
    .Range("A" & NewLig).Value = Sh.Range("F1").Value
    .Range("B" & NewLig).Value = Sh.Range("C10").Value
    .Range("C" & NewLig).Value = IIf(Val(Sh.Range("D19").Value) <> 0, Sh.Range("D19").Value, "")
    .Range("E" & NewLig).Value = IIf(Val(Sh.Range("E19").Value) <> 0, Sh.Range("E19").Value, "")
    .Range("I" & NewLig).Value = IIf(Val(Sh.Range("G19").Value) <> 0, Sh.Range("G19").Value, "")
    .Range("J" & NewLig).Value = IIf(Val(Sh.Range("F19").Value) <> 0, Sh.Range("F19").Value, "")
    .Range("K" & NewLig).Value = IIf((Sh.Range("H33").Value) = "x" Or (Sh.Range("H33").Value) = "X", "F", Workbooks(Monfichier).Sheets("2011c").Range("M" & NewLig).Value)
    .Range("K" & NewLig).Value = IIf((Sh.Range("H34").Value) = "x" Or (Sh.Range("H34").Value) = "X", "R", Workbooks(Monfichier).Sheets("2011c").Range("M" & NewLig).Value)
    .Range("K" & NewLig).Value = IIf((Sh.Range("H35").Value) = "x" Or (Sh.Range("H35").Value) = "X", "E", Workbooks(Monfichier).Sheets("2011c").Range("M" & NewLig).Value)
    .Range("N" & NewLig).Value = "Accepté"
 
    End If
 
End With
    wb.Save
    wb.Close
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:="infotec  ISC 4045 RPCS"
    Workbooks("Teste Pochette dossier PM.xlsm").Sheets("Mutual.").Range("F1").MergeArea.ClearContents
End If
MsgBox "Clic encore une fois le fichier était ouvert !"
ElseIf pmcopie = "n" Then
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:="infotec  ISC 4045 RPCS"
Workbooks("Teste Pochette dossier PM.xlsm").Sheets("Mutual.").Range("F1").MergeArea.ClearContents
End If
Set Sh = Nothing
Set wb = Nothing
End Sub

En gros il doit regarder si il y a bien un code de fichier (pm copie = o)
Si le fichier est ouvert tu referme et tu fais rien sur ma page, just tu indique qu'il faut recommencer le clic plus tard.
Si le fichier n'est pas ouvert alors tu copie les données suivant des conditions, tu ferme, tu sauvegarde, tu imprime et ensuite tu met à blanc une case pour montrer que ta bien fait ton travail !

si (pm copie = n) alors tu imprime tu met à blanc la case

et voilà

Du coup j'ai sortie ce code qui je pense doit être possible de simplifier ou pas ?

d'avance encore merci !

**hdisnice** · 30/06/2011, 08h44

Bonjour,

Enfin ma question c'était surtout il y a des erreurs de novice dans mon code je pense. Alors si c'était possible de me les corriger ou optimiser le code ?

pour l'instant il fonctionne pour moi... Il est juste un peu lent quand il vérifie si le fichier est déjà ouvert.

Enfin encore merci.

Simplifier mon code ?

Macros et VBA Excel

Discussions similaires

Partager

Partager