macro liste validation de mDF

[Christian]

Bonjour à tout le forum, et à myDearFriend,

Didier a réalisé cette liste de validation choix familles puis articles. J'aimerais savoir si il est possible d'amener un petit aménagement à la macro de Didier ?

fichier joint;

Je vous remercie du temps que vous voudrez bien m'accorder.

Bien amicalement

Christian [file name=ListeValmDF.zip size=13523]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/ListeValmDF.zip[/file]

 

[edelweisseric]

Bonjour Christian

As tu essayé cece :

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
c = ActiveCell.Column
If c = 3 Then activecell.offset(0,-3).value=activecell.value ''''''''ou autre chose : Date, ...
end if

end sub

Cordialement

 

[Christian]

Re, Bonjour,edelweisseric

edelweisseric, merci pour ta réponse mais où dois-je placer ce code, ne va-t-il pas perturber le fonctionnement du code initial ?, je pensais plutôt à une modif du code existant ?.
à+
Christian

 

[edelweisseric]

Bonjour Christian

Cela ne devrait rien contrarier du tout. Il faut que tu le places avant : On Error GoTo Fin

Tu dis ' pour qu'au premier choix de la liste famille, dans mon cas des dates, ' est ce dans une liste de dates ? une liste de bananes, betteraves,...? est ce seulement à la première fois que tu fais un choix ?

Essaie et si cela ne te va pas, n'hésite pas tu nous éclaire un peu plus

Cordialement

 

[Christian]

Re edelweisseric,

Ci-joint le code avec ton code,ça plante devant :C = ActiveCell.Column.
Ce que je souhaite ; au premier click choix date, copier la date sur la même ligne en colonne A, avant le 2ème click choix articles.

merci à+
Christian

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim FParam As Worksheet
Dim Fam As Range
Dim V As String
Dim L As Long
Dim F As Byte, C As Byte
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
C = ActiveCell.Column
If C = 3 Then ActiveCell.Offset(0, -3).Value = ActiveCell.Value ''''''''ou autre chose : Date, ...
End If

End Sub

On Error GoTo Fin
V = Target.Validation.Formula1
If Left(V, 4) = '=mDF' Then
Set FParam = Sheets('mDF')
Set Fam = FParam.Range('mDF')
If V = '=mDF' Then
For F = 1 To Fam.Count
If Fam(F) = Target.Text Then
C = F
Exit For
End If
Next F
If C > 0 Then
L = FParam.Cells(65536, C).End(xlUp).Row
ActiveWorkbook.Names.Add Name:='mDF1', RefersTo:='=mDF!' & Range(Cells(2, C), Cells(L, C)).Address 'Sheets('mDF').Range('B1:B3').Address
End If
End If
Target.Validation.Modify Formula1:=IIf(V = '=mDF1', '=mDF', '=mDF1')
End If
Fin:
End Sub

 

[edelweisseric]

Re bonjour

Pourtant je n'ai pas manger trop lourd à midi, mais j'ai la comprenette difficile

Tout d'abord tu as ajouté :

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
C = ActiveCell.Column
If C = 3 Then ActiveCell.Offset(0, -3).Value = ActiveCell.Value ''''''''ou autre chose : Date, ...
End If

End Sub

garde seulement :

C = ActiveCell.Column
If C = 3 Then ActiveCell.Offset(0, -3).Value = ActiveCell.Value
End If

Par contre je ne vois pas 'choix date' donc j'ai les méninges qui s'entrechoquent.

Essaie avec la nouvelle donne et si ... reviens à la charge

Cordialement

 

[myDearFriend!]

Bonjour Christian, edelweisseric,

Si j'ai bien compris la question, ajoute dans la procédure d'origine la ligne en gras ci-dessous :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim FParam As Worksheet
Dim Fam As Range
Dim V As String
Dim L As Long
Dim F As Byte, C As Byte
      On Error GoTo Fin
      V = Target.Validation.Formula1
      If Left(V, 4) = '=mDF' Then
            Set FParam = Sheets('mDF')
            Set Fam = FParam.Range('mDF')
            If V = '=mDF' Then
                  For F = 1 To Fam.Count
                        If Fam(F) = Target.Text Then
                              C = F
                              Exit For
                        End If
                  Next F
                  If C > 0 Then
                        L = FParam.Cells(65536, C).End(xlUp).Row
                        ActiveWorkbook.Names.Add Name:='mDF1', RefersTo:='=mDF!' & _
                              Range(Cells(2, C), Cells(L, C)).Address
                  End If
            End If
                  Target.Validation.Modify Formula1:=IIf(V = '=mDF1', '=mDF', '=mDF1')
                  If V = '=mDF' Then ActiveCell.EntireRow.Range('A1') = ActiveCell
            End If
      End If
Fin:
End Sub

Cordialement,

 

[Christian]

Re myDearFriend!,edelweisseric,

Merci à vous,

Didier c'est bon, c'est pile poils ce que je souhaitais, inscrire la famille en 'ligne' au moment du premier choix , ici des dates.

Encore merci Ddier et
merci égalementà edelweisseric.

Bien amicalement,

Christian

 

[myDearFriend!]

Re,

Je viens de m'apercevoir qu'on pouvait éviter un test inutile (If V = '=mDF' Then) car déjà présent plus haut dans le code...

Donc :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim FParam As Worksheet
Dim Fam As Range
Dim V As String
Dim L As Long
Dim F As Byte, C As Byte
      On Error GoTo Fin
      V = Target.Validation.Formula1
      If Left(V, 4) = '=mDF' Then
            Set FParam = Sheets('mDF')
            Set Fam = FParam.Range('mDF')
            If V = '=mDF' Then
                  For F = 1 To Fam.Count
                        If Fam(F) = Target.Text Then
                              C = F
                              Exit For
                        End If
                  Next F
                  If C > 0 Then
                        L = FParam.Cells(65536, C).End(xlUp).Row
                        ActiveWorkbook.Names.Add Name:='mDF1', RefersTo:='=mDF!' & _
                              Range(Cells(2, C), Cells(L, C)).Address
                  End If
                  ActiveCell.EntireRow.Range('A1') = ActiveCell
            End If
            Target.Validation.Modify Formula1:=IIf(V = '=mDF1', '=mDF', '=mDF1')
      End If
Fin:
End Sub