Modification d'un code

Le 22/02/2012 à 16:01
31ada.xlsm (30.32 Ko)

Bonjour,

Je vous adresse un fichier dans lequel je voudrais modifier un code (les explications sont fournies dans le fichier).

Merci.

Feever

Le 22/02/2012 à 21:57

Bonjour feever,

Un essai avec cette formule à mettre en D3 de la feuille Fourniture et à tirer vers le bas :

=INDEX(Devis!$B$2:$B$32;EQUIV("*";Devis!$B$2:$B$32;)+LIGNES($D$2:D2)-1)
Le 23/02/2012 à 08:37

Bonjour,

J'ai mis cette formule en application, c'est une bonne approche mais il faudrait que cela fasse en même temps le tri.

C'est pour préparer le bon de commande fournisseur.

Je te remercie.

Feever

Le 23/02/2012 à 09:53

Re,

En VBA c'est plus simple ! Essaie ce code :

Sub PrepBonCde()
    With Sheets("Fourniture").Range("D3:D11")
        .NumberFormat = "General"
        .FormulaR1C1 = _
        "=INDEX(Devis!R2C2:R32C2,MATCH(""*"",Devis!R2C2:R32C2,)+ROWS(R2C4:R[-1]C)-1)"
        .NumberFormat = "@"
        .Value = .Value
        .Sort key1:=[D3]
    End With
End Sub
Le 23/02/2012 à 10:58

C'est bien, celle-ci pourrait être automatique au remplissage des informations de la colonne B de la feuille Devis?

Le 23/02/2012 à 11:26

Un code à mettre dans le code de la feuille Devis :

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column <> 2 And Target.Count > 1 Then Exit Sub
    With Sheets("Fourniture")
        .Range("D:D").NumberFormat = "General"
        .Range("D3").FormulaR1C1 = _
        "=INDEX(Devis!R2C2:R32C2,MATCH(""*"",Devis!R2C2:R32C2,)+ROWS(R2C4:R[-1]C)-1)"
        .Range("B3:G3").AutoFill Destination:=.Range("B3:G11"), Type:=xlFillDefault
        .Range("D:D").NumberFormat = "@"
        With .Range("D3:D11")
            .Value = .Value
            .Sort key1:=Sheets("Fourniture").[D3]
        End With
    End With
End Sub

Les plages seront à adapter en fonction de tes souhaits.

Le 23/02/2012 à 13:50

J'ai bien mis le code dans la feuille, mais un message s'affiche ; nom ambigu détecté : Worksheet_Change?

Le 23/02/2012 à 14:02

Ce message s'affiche car deux procédures portent le même nom.

As-tu bien mis le code dans le code de la feuille Devis ?

Dans le fichier que tu as joint au début, il n'y avait pas de code dans cette feuille.

Le 23/02/2012 à 14:06

SI, il y a déjà 2 codes :

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$N$3" Then

ActiveSheet.Hyperlinks.Add Anchor:=Target, Address:=Target.Value, TextToDisplay:=Target.Value

End If

End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Application.Intersect(Target, Range("C8")) Is Nothing Then

datedujoura

End If

End Sub

Le 23/02/2012 à 14:14

Bonjour,

C'est ton autre petit bout de code en worksheet_change qui fait bugguer, efface tout le code et mets le code de vba-new modifié comme ceci :

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column <> 2 And Target.Count > 1 Then Exit Sub
    With Sheets("Fourniture")
        .Range("D:D").NumberFormat = "General"
        .Range("D3").FormulaR1C1 = _
        "=INDEX(Devis!R2C2:R32C2,MATCH(""*"",Devis!R2C2:R32C2,)+ROWS(R2C4:R[-1]C)-1)"
        .Range("B3:G3").AutoFill Destination:=.Range("B3:G11"), Type:=xlFillDefault
        .Range("D:D").NumberFormat = "@"
        With .Range("D3:D11")
            .Value = .Value
            .Sort key1:=Sheets("Fourniture").[D3]
        End With
    End With

    If Target.Address = "$N$3" Then
           ActiveSheet.Hyperlinks.Add Anchor:=Target, Address:=Target.Value, TextToDisplay:=Target.Value
    End If
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Application.Intersect(Target, Range("C8")) Is Nothing Then
    datedujoura
End If

End Sub

Cordialement,

Le 23/02/2012 à 14:34

C'est OK.

Pour démarrer correctement le feuille Fournisseur, je démarre par la colonne A, comment passer de D en A?

Le 23/02/2012 à 14:41

Bonjour

Pas sur que le code modifié fonctionne normalement (mais je peux me planter)

Private Sub Worksheet_Change(ByVal Target As Range)

  If Target.Count > 1 Then Exit Sub

  If Not Intersect(Columns(2), Target) Is Nothing Then
    With Sheets("Fourniture")
      .Range("D:D").NumberFormat = "General"
      .Range("D3").FormulaR1C1 = _
            "=INDEX(Devis!R2C2:R32C2,MATCH(""*"",Devis!R2C2:R32C2,)+ROWS(R2C4:R[-1]C)-1)"
      .Range("B3:G3").AutoFill Destination:=.Range("B3:G11"), Type:=xlFillDefault
      .Range("D:D").NumberFormat = "@"
      With .Range("D3:D11")
        .Value = .Value
        .Sort key1:=Sheets("Fourniture").[D3]
      End With
    End With
  ElseIf Target.Address = "$N$3" Then
    ActiveSheet.Hyperlinks.Add Anchor:=Target, Address:=Target.Value, TextToDisplay:=Target.Value
  End If
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

  If Not Application.Intersect(Target, Range("C8")) Is Nothing Then
    datedujoura
  End If

End Sub
Le 23/02/2012 à 14:46

Oui banzai tu as raison, je n'avais pas fait attention sur la condition de la première partie, et du coup tout click en dehors de la colonne 2 faisant sortir de la sub, la condition pour la cellule N3 n'aurait jamais été testée, tu as bien fait de modifier.

Enfin quoi que, il faut que cela soit en dehors de la colonne 2 ET qu'il y ai plusieurs cellules modifiées pour sortir de la sub, donc cela marche peut-être quand même, à tester. ^^

Cordialement,

messondewez a écrit :

C'est OK.

Pour démarrer correctement le feuille Fournisseur, je démarre par la colonne A, comment passer de D en A?

Comment ça ? tu veux que la macro mettent les formules en colonne A plutot qu'en colonne D ? ou autre chose ?

Le 23/02/2012 à 15:02

oui; que le tableau soit bien fait!

Rechercher des sujets similaires à "modification code"