Macro capricieuse

[Calvus]

Bonsoir le Forum,

J'ai un classeur de gestion de clients et de prospects.

Sur le 1er onglet, je peux choisir de sélectionner Facture ou Pro Forma, de valider une facture ou pro forma, et d'en importer.

Je bute sur un problème que je n'arriva pas à résoudre.

En B12 se fait le choix du client ou du prospect.*

* (Pour cela, il faut sélectionner le bouton facture / pro forma et choisir en B12 et la liste de validation sefait sur l'un ou l'autre onglet)

En colonnes AA, AB, AD et AE s'inscrivent les noms et dates, selon le modèle choisi.

Or, en validant une facture, si un prospect est choisi, il se produit un bug. Toutes les coordonnées sont écrites en AA, à savoir adresse, etc, alors que seul le nom devrait figurer. Le problème vient de la macro Private Sub Worksheet_Change(ByVal Target As Range) qui ne devrait pas être sollicitée à cet endroit..
Idem, si on valide une pro forma alors qu'on a choisi un client.

Et je me rends compte à l'instant en testant le fichier que je vous envoie que ça ne veut plus fonctionner du tout...
Je suis perplexe.
J'envoie quand même en atendant de voir d'où ça peut venir.

Si ma demande n'est pas assez claire, faites le moi savoir.

Merci de votre aide.

Je joins 3 fichiers : le principal + 2 autres destinés à recevoir les données enregistrées.

 

[DoubleZero]

Re : Macro capricieuse

Bonjour, Calvus , le Forum,

En attendant mieux... peux-tu tester les fichier joints, après avoir modifié ce qui doit l'être (chemin d'accès des fichiers).

Seule la partie "Facture" est traitée.

A bientôt

 

[Calvus]

Re : Macro capricieuse

Bonjour 00 , le forum,

Tu es encore une fois celle qui vient à ma rescousse. Je t'en remercie car mon fil tombait déjà dans l'oubli...


Alors, plusieurs choses :

La macro plante chez moi ici :

ActiveSheet.Name = [B12].Value & " du " & Format([f5], "ddmmyyyy")

Après cette instruction :

'---------------------------------------------------------------------------------Modifier ici
        LePath = "C:\Users\.........\Downloads\"
        ActiveSheet.Copy
        ActiveSheet.Name = [B12].Value & " du " & Format([f5], "ddmmyyyy")

Par ailleurs, je ne comprends pas ces lignes dans les formules à supprimer :

or Each c In ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 23)
            c.Value = c.Value
        Next
        For Each n In ActiveWorkbook.Names
            n.Delete
        Next

Ni celles-ci dans copie du fichier F :

 For Each n In ActiveWorkbook.Names
            n.Delete

Enfin, l'incrémentation des cellules B13 àC15 ne se fait pas, mais je suppose que l'on est obligé de continuer à passer par la sub Change ByVal pour cela.

En tout cas merci, et à bientôt.

 

[DoubleZero]

Re : Macro capricieuse

Re-bonjour,

... Tu es encore une fois celle qui vient à ma rescousse. Je t'en remercie car mon fil tombait déjà dans l'oubli...

Merci, Calvus , mais la "rescousse" n'est, visiblement, pas salvatrice

... La macro plante chez moi ici :

ActiveSheet.Name = [B12].Value & " du " & Format([f5], "ddmmyyyy")

Après cette instruction :

'---------------------------------------------------------------------------------Modifier ici
        LePath = "C:\Users\.........\Downloads\"
        ActiveSheet.Copy
        ActiveSheet.Name = [B12].Value & " du " & Format([f5], "ddmmyyyy")

...

Je ne sais quelle modification suggérer car les tests effectués sur mon poste sont corrects.

... Par ailleurs, je ne comprends pas ces lignes dans les formules à supprimer :

or Each c In  ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 23)
            c.Value = c.Value
        Next
        For Each n In ActiveWorkbook.Names
            n.Delete
        Next

Ni celles-ci dans copie du fichier F :

 For Each n In ActiveWorkbook.Names
            n.Delete

...

Ces lignes, destinées à la copie de l'onglet "Facture Pro Forma", ont pour objectifs de :

- remplacer les formules par des constantes ;

- supprimer les champs nommés.

... Enfin, l'incrémentation des cellules B13 àC15 ne se fait pas, mais je suppose que l'on est obligé de continuer à passer par la sub Change ByVal pour cela...

J'ai certainement supprimé des lignes de code qui devaient "vivre" pour la partie "Facture".

M'en vais replonger, aussi vite que possible, mon petit neurone dans ce nid à "bb à la tête" !

A bientôt

 

[DoubleZero]

Re : Macro capricieuse

Bonjour, Calvus , le Forum,

...La macro plante chez moi ici :

ActiveSheet.Name = [B12].Value & " du " & Format([f5], "ddmmyyyy")

...

Peux-tu, s'il te plaît, tester cette partie ("Facture") ?

Option Explicit
Public c As Range, lepath As String, lenom As String, fichier As String, dossier As String, chemin As String, nouvonglet As String, DLePath As String, n
Private Sub commandbutton1_click()
    With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
    If Range("e2") = "Facture" Then
        [e4] = "Facture n°"
        With Range("az1"): .Value = Range("f5").Value: .NumberFormat = "ddmmyyyy": End With
        Range("l1") = Range("l1") + 1
        Range("e5") = Range("g5") & " " & Range("f5") & Range("l1")
        If Range("f5") <> Date Then
            ActiveSheet.Shapes("alerte").Visible = True
            Exit Sub
        Else
            ActiveSheet.Shapes("alerte").Visible = False
        End If
        For Each c In Range("aa1:aa50").SpecialCells(xlCellTypeConstants)
            If c.Value = Range("b12").Value And c.Offset(, 1) = Range("f5").Value Then
                MsgBox "Attention, M'sieur : facture en doublon !"
                Range("l1") = Range("l1") - 1
                Exit Sub
            End If
        Next
        Range("aa" & Rows.Count).End(xlUp)(2) = [b12]
        Range("ab" & Rows.Count).End(xlUp)(2) = [f5]
        lepath = "C:\Users\00\Downloads\"    'emplacement adapter
        ActiveSheet.Copy
        ActiveSheet.Name = [b12].Value & " du " & [a1].Text
        [az1] = ""
        ' ActiveSheet.Name = [B12].Value & " du " & Format([f5], "ddmmyyyy") ' pas ok chez Calvus
        ActiveSheet.Shapes.Range(Array("CommandButton1", "CommandButton2", _
                                       "ToggleButton1", "ToggleButton2", "CommandButton3", "CommandButton4")).Delete
        For Each c In ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 23)
            c.Value = c.Value
        Next
        For Each n In ActiveWorkbook.Names
            n.Delete
        Next
        Application.DisplayAlerts = False
        lenom = [b12] & " F du " & Format([f5], "ddmmyyyy") & ".xlsx"
        With ActiveWorkbook: .SaveAs lepath & lenom: .Close: End With
        Application.DisplayAlerts = True
        Sheets("Facture Pro Forma").Copy Before:=Sheets(4)
        Workbooks.Open ("C:\Users\00\Downloads\00 - Calvus - Historique F.xlsm")    'emplacement adapter
        Windows("00 - Calvus - F et FP.xlsm").Activate
        Sheets("Facture Pro Forma (2)").Select
        Application.DisplayAlerts = False
        Sheets("Facture Pro Forma (2)").Move after:=Workbooks("00 - Calvus - Historique F.xlsm").Sheets(1)    'emplacement adapter
        For Each n In ActiveWorkbook.Names
            n.Delete
        Next
        Application.DisplayAlerts = True
        ActiveSheet.Name = [b12] & " du " & Format([f5], "ddmmyyyy")
        ActiveWindow.Zoom = 80
        ActiveWorkbook.Close True
        Sheets("Facture Pro Forma").Select
        Range("a1:h67").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                                            "C:\Users\00\Downloads\" & Range("b12") & " Facture du " & Format([f5], "ddmmyyyy") & ".pdf", quality:=xlQualityStandard, _
                                            includedocproperties:=True, ignoreprintareas:=False, openafterpublish:=False    ' emplacement adapter
        With Feuil15.Range("b" & Rows.Count).End(xlUp)(2)
            .Offset(0, 0) = Feuil20.Range("g5")
            .Offset(0, 1) = Feuil20.Range("b12")
            .Offset(0, 2) = Feuil20.Range("c15")
            .Offset(0, 3) = Feuil20.Application.Index(Feuil10.[b:n], Application.Match(Feuil20.[d11], Feuil10.[b:b], 0), 12)
            .Offset(0, 4) = Application.Index(Feuil10.[b:n], Application.Match(Feuil20.[d11], Feuil10.[b:b], 0), 13)
            .Offset(0, 5) = Feuil20.Range("h61")
            .Offset(0, 6) = Feuil20.Range("f5")
        End With
        With Sheets("Ventes").Range("b2").CurrentRegion
            .Borders.Value = 1
            .Interior.Color = 15853019
            .BorderAround xlContinuous, xlMedium, xlColorIndexAutomatic
        End With
        With Sheets("Ventes").Range("b2:h2"): .Interior.Color = 12419407: .Font.Bold = True: .Font.ColorIndex = 2: _
                .BorderAround xlContinuous, xlMedium, xlColorIndexAutomatic: End With
    End If
    With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub
''**************************************************************************************************************

...Par ailleurs, je ne comprends pas ces lignes dans les formules à supprimer :

or Each c In  ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 23)
            c.Value = c.Value
        Next
        For Each n In ActiveWorkbook.Names
            n.Delete
        Next

Ni celles-ci dans copie du fichier F :

 For Each n In ActiveWorkbook.Names
            n.Delete

Enfin, l'incrémentation des cellules B13 àC15 ne se fait pas, mais je suppose que l'on est obligé de continuer à passer par la sub Change ByVal pour cela...

Si, pour la copie, tu préfères conserver champs nommés, formules et boutons, ces lignes peuvent être supprimées.

La mise à jour des valeurs en b13:c15 est rétablie.

Aujourd'hui, pas pu faire plus / mieux...

A bientôt

 

[Calvus]

Re : Macro capricieuse

Bonsoir 00 ,

Bon ! Merci !
Ça fonctionne plutôt bien. Pas avec tous les noms....

Je testerai demain sur mon fichier original. Il faut que j'adapte et je reviendrai te dire ce qu'il en est.

A bientôt.

 

[Calvus]

Re : Macro capricieuse

Bonsoir 00 ,

Bon ! Merci !
Ça fonctionne plutôt bien. Pas avec tous les noms....

Je testerai demain sur mon fichier original. Il faut que j'adapte et je reviendrai te dire ce qu'il en est.

A bientôt.

 

[DoubleZero]

Re : Macro capricieuse

Bonjour, Calvus , le Forum,

Peux-tu remplacer le code déposé en #5 par celui-ci ?

Option Explicit
Public c As Range, lepath As String, lenom As String, fichier As String, dossier As String, chemin As String, nouvonglet As String, DLePath As String, n, choix
Private Sub commandbutton1_click()
    With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
    If Range("e2") = "Facture" Then
        [g5].FormulaR1C1 = "=INDEX(Clients!C[-6],MATCH('Facture Pro Forma'!R[7]C[-5],Clients!C[-5],0))"
        [e4] = "Facture n°"
        [h67].Name = "TTC"
        With Range("az1"): .Value = Range("f5").Value: .NumberFormat = "ddmmyyyy": End With
        Range("l1") = Range("l1") + 1
        Range("e5") = Range("g5") & " " & Range("f5") & Range("l1")
        If Range("f5") <> Date Then choix = MsgBox("La date en f5 est erronée. Souhaites-tu la conserver ?", vbYesNo, "Attention, petit poisson...")
        If choix = vbNo Then Exit Sub
        For Each c In Range("aa1:aa50").SpecialCells(xlCellTypeConstants)
            If c.Value = Range("b12").Value And c.Offset(, 1) = Range("f5").Value Then
                MsgBox "Attention, M'sieur : facture en doublon !"
                Range("l1") = Range("l1") - 1
                Exit Sub
            End If
        Next
        Range("aa" & Rows.Count).End(xlUp)(2) = [b12]
        Range("ab" & Rows.Count).End(xlUp)(2) = [f5]
        lepath = "C:\Users\00\Downloads\"    'emplacement adapter
        ActiveSheet.Copy
        ActiveSheet.Name = Left([b12], 19) & " du " & [az1].Text
        'ActiveSheet.Name = [b12].Value & " du " & [a1].Text 'pas ok si nom onglet > 31 caractères
        ' ActiveSheet.Name = [B12].Value & " du " & Format([f5], "ddmmyyyy") ' pas ok chez Calvus
        ActiveSheet.Shapes.Range(Array("CommandButton1", "CommandButton2", _
                                       "ToggleButton1", "ToggleButton2", "CommandButton3", "CommandButton4")).Delete
        For Each c In ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 23)
            c.Value = c.Value
        Next
        For Each n In ActiveWorkbook.Names
            n.Delete
        Next
        Application.DisplayAlerts = False
        lenom = [b12] & " F du " & Format([f5], "ddmmyyyy") & ".xlsx"
        With ActiveWorkbook: .SaveAs lepath & lenom: .Close: End With
        Application.DisplayAlerts = True
        Sheets("Facture Pro Forma").Copy Before:=Sheets(4)
        Workbooks.Open ("C:\Users\00\Downloads\00 - Calvus - Historique F.xlsm")    'emplacement adapter
        Windows("00 - Calvus - F et FP.xlsm").Activate
        Sheets("Facture Pro Forma (2)").Select
        Application.DisplayAlerts = False
        Sheets("Facture Pro Forma (2)").Move after:=Workbooks("00 - Calvus - Historique F.xlsm").Sheets(1)    'emplacement adapter
        For Each n In ActiveWorkbook.Names
            n.Delete
        Next
        Application.DisplayAlerts = True
        ActiveSheet.Name = Left([b12], 19) & " du " & [az1].Text
        ActiveWindow.Zoom = 80
        ActiveWorkbook.Close True
        Sheets("Facture Pro Forma").Select
        Range("a1:h67").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                                            "C:\Users\00\Downloads\" & Range("b12") & " Facture du " & Format([f5], "ddmmyyyy") & ".pdf", quality:=xlQualityStandard, _
                                            includedocproperties:=True, ignoreprintareas:=False, openafterpublish:=False    ' emplacement adapter
        With Feuil15.Range("b" & Rows.Count).End(xlUp)(2)
            .Offset(0, 0) = Feuil20.Range("g5")
            .Offset(0, 1) = Feuil20.Range("b12")
            .Offset(0, 2) = Feuil20.Range("c15")
            .Offset(0, 3).FormulaR1C1 = "=VLOOKUP(RC[-3],Clients!C[-4]:C[9],13,0)"
            .Offset(0, 4).FormulaR1C1 = "=VLOOKUP(RC[-4],Clients!C[-5]:C[8],14,0)"
            .Offset(0, 5) = Range("TTC")
            .Offset(0, 6) = Feuil20.Range("f5")
            .Columns("b:h").EntireColumn.AutoFit
        End With
        With Sheets("Ventes").Range("b2").CurrentRegion
            .Borders.Value = 1
            .Interior.Color = 15853019
            .BorderAround xlContinuous, xlMedium, xlColorIndexAutomatic
        End With
        With Sheets("Ventes").Range("b2:h2"): .Interior.Color = 12419407: .Font.Bold = True: .Font.ColorIndex = 2: _
                .BorderAround xlContinuous, xlMedium, xlColorIndexAutomatic: End With
    End If
    With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub

A bientôt

 

[Calvus]

Re : Macro capricieuse

Bonsoir 00 ,

Je te remercie de t'être donné tant de mal.
Malheureusement, c'est presque pour rien...

En effet en en cherchant à comprendre ce qui n'allait pas dans mon code, et en cherchant, j'ai compris ce qui posait problème. Une simple petite ligne...

Il a suffi de remplacer dans l’événement de la feuille :

If Target = Range("B12") And Target.Count = 1 And [E2] = "Facture" Then

Par :

If Not Intersect([B12], Target) Is Nothing And Target.Count = 1 And [E2] = "Facture" Then

Du coup, tout fonctionne parfaitement, après une trentaine d'essais dans tous les sens.

En revanche, je suis en train d'adapter des bouts de ton code pour améliorer le mien. Notamment pour effacer les données des nouvelles feuilles.
Et l'analyse de ton code m'a appris plein de nouvelles choses.
Merci pour tout cela. Et vraiment désolé si tu as perdu ton temps. D'autant plus que je te suis vraiment gré d'avoir cherché à m'aider. Tu as été la seule sur ce coup là.

A bientôt

 

[DoubleZero]

Re : Macro capricieuse

Re-bonjour ,

...

Je te remercie de t'être donné tant de mal.
Malheureusement, c'est presque pour rien...
...

Petit Poisson, la facture sera salée, très salée : un wagon de Dlicrâne !

...
l'analyse de ton code m'a appris plein de nouvelles choses.
Merci pour tout cela...

V'là une bonne nouvelle ! Mais... Petit Pisson, la facture sera salée, extrêmement salée !

... vraiment désolé si tu as perdu ton temps...

Le temps... c'est de l'argent ! Quel est le numér de ta carte bleue ?

A bientôt

 

[Calvus]

Re : Macro capricieuse

Bonsoir 00 ,

C'est pour ton bien, pour conserver tes neurones actifs !

Petit problème.....

La macro bloque ici :

[Highlight=VB]For Each n In ActiveWorkbook.Names
n.Delete
Next[/code]

Une idée ?

 

[DoubleZero]

Re : Macro capricieuse

Bonjour, Calvus , le Forum,

...C'est pour ton bien, pour conserver tes neurones actifs !..

Crois-tu que j'en ai plusieurs ?

...La macro bloque ici...

Sans doute parce qu'il n'existe aucun champ nommé. Si tel est le cas, tu peux ajouter, juste avant ces trois lignes :

On Error Resume Next

A bientôt

 

[Calvus]

Re : Macro capricieuse

Sans doute parce qu'il n'existe aucun champ nommé. Si tel est le cas, tu peux ajouter, juste avant ces trois lignes :

Non non. Il y en a plein. Mais je viens d'avoir une idée. Je vais redémarrer mon PC. J'ai remarqué qu'au bout d'un moment il y avait plein de bugs qui se règlent après redémarrage. Je ne sais pas si c'est bien normal mais ça me l'a fait plusieurs fois ces derniers temps. Je reviens donc après avoir redémarré LA machine....

 

[DoubleZero]

Re : Macro capricieuse

Re-bonjour,

Non non. Il y en a plein...

Oui, c'est la raison pour laquelle j'ai inséré ces trois lignes.

Quant aux "bugs qui se règlent après redémarrage"... cela se produit chez moi itou. L'ordinateur est capricieux...

A bientôt

 

[Calvus]

Re : Macro capricieuse

Re

Bon. Ça ne vient pas de là. Ça ne fonctionne toujours pas... Est ce parce que ça fait référence au classeur ouvert du coup ? Mystère..
JB, si tu passes par là...

A bientôt