DEPLACEMENT AVEC TABULATION

bennisay · 23 Septembre 2016

bonjour LE FORUM

j ai une question . comment combiner deux codes VBA pour faire ca

Si Je suis sur la cellule "b1" je veux me deplacer sur la cellule "a3" avec tabulation

Et si je suis sur la cellule "b5" je veux me deplacer sur la cellule "a6" avec tabulation
Et si je suis sur la cellule "b6" je veux me deplacer sur la cellule "a7" avec tabulation

ma feuille est nomé " MOUVEMENT"
Merci pour votre aide

pierrejean · 23 Septembre 2016

Bonjour bennisay

A tester dans le module de la feuille

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$C$1" Then Range("A3").Select
If Target.Address = "$C$5" Then Range("A6").Select
If Target.Address = "$C$6" Then Range("A7").Select
End Sub

Robert · 23 Septembre 2016

Bonjour Bennisay, bonjour le forum,

Tu peux essayer comme ça :

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$C$1" Then Range("A3").Select
If Target.Address = "$C$5" Then Range("A6").Select
If Target.Address = "$C$6" Then Range("A7").Select
End Sub

À placer dans l'onglet concerné... Mais attention ! Pour pouvoir désormais sélectionner les cellules C1, C5 ou C6 de cet onglet, il te faudra désactiver les macros événementielles.
Je te recommande de copier aussi, dans un module standard les deux macros si-dessous pour désactiver et réactiver :

VB:

Sub Desactiv()
Application.EnableEvents = False
End Sub

Sub Activ()
Application.EnableEvents = True
End Sub

[Edition]
Bonjour PierreJean nos posts se sont croisés...

bennisay · 23 Septembre 2016

BONJOUR pierrejean
Ca ne fonctionne ps
Quand je suis sur la cellule "c1" et je click sur tabulation je ne me peplace pas sur "a3" part contre sur la cellule ""c2"

Robert · 23 Septembre 2016

Bonjour le fil, bonjour le forum,

Tu as mis le code où ?

bennisay · 23 Septembre 2016

BONJOUR
Non ce que je veux c est : mettre une valeur dans la cellule "c1" et quand je click sur tabulation je dois me trouver dans le cellule "a3"
et merci

bennisay · 23 Septembre 2016

bonjour
j ai mis le code mais en le testant j ai trouve que je ne peux pas mettre une valeur sur la cellule "c3" je me trouve directement sur la cellule "a3"

pierrejean · 23 Septembre 2016

Re
Salut Robert
Alors tester:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$1" Then Range("A3").Select
If Target.Address = "$B$5" Then Range("A6").Select
If Target.Address = "$B$6" Then Range("A7").Select
End Sub

Toujours a mettre dans le module de la feuille

Robert · 23 Septembre 2016

Re,

j ai mis le code mais en le testant j ai trouve que je ne peux pas mettre une valeur sur la cellule "c3" je me trouve directement sur la cellule "a3"

Tu dois parler de C1 car C3 ça marche. C'est ce que je t'expliquais dans mon premier post. Mais si tu lis pas c'est ton problème...

bennisay · 23 Septembre 2016

reb
Merci jeanpierre et Robert
ca fonctionne parfaitement
chapeau c est reussis

bennisay · 23 Septembre 2016

REB
Desole mais quand j ai mis le code fournis dans tt ces codes j ai eu un message d erreur
pourriez vous m indiquer ou je dois mettre le code et quesque je dois changer et merci

quand j ai dis que ca fonctionne c etait sur un dossier vide mais sur mon propre dossier avec les codes j ai ps resussis

Code:

Dim a()
Private Sub ComboBox2_Change()
If Me.ComboBox2 <> "" And IsError(Application.Match(Me.ComboBox2, a, 0)) Then
   Me.ComboBox2.List = Filter(a, Me.ComboBox2.Text, True, vbTextCompare)
   Me.ComboBox2.DropDown
End If
   ActiveCell.Value = Me.ComboBox2
End Sub
Private Sub ComboBox3_Change()
   ActiveCell.Value = Me.ComboBox3
End Sub
Private Sub ComboBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Me.ComboBox2.List = a
  Me.ComboBox2.Activate
  Me.ComboBox2.DropDown
End Sub
Private Sub CommandButton1_Click()
Dim msg, style, title

    Dim Retour As Integer

    With Sheets("LIVRAISON")
  
       
    '---------------- Impression noir et blanc ou couleur ------------------------
    Retour = MsgBox("Voulez-vous une copie couleur : N/O ", vbNoYes + vbCritical)
    If Retour = vbNo Then
        With ActiveSheet.PageSetup
            .BlackAndWhite = True
        End With
    End If
    ActiveSheet.PageSetup.PrintArea = "B2:I55"
    'ActiveSheet.PrintPreview
    ActiveWindow.SelectedSheets.PrintPreview 'PrintOut copies:=1
End With
End Sub

Private Sub CommandButton2_Click()
UserForm3.Show
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect([H7:H35], Target) Is Nothing Then
Application.OnKey Key:="~", procedure:="retour_colonneC"

End If


  If Not Intersect([C7:C35], Target) Is Nothing And Target.Count = 1 Then
    a = Application.Transpose(Sheets("bdd").Range("liste"))
    Me.ComboBox2.List = a
    Me.ComboBox2.Height = Target.Height + 3
    Me.ComboBox2.Width = Target.Width
    Me.ComboBox2.Top = Target.Top
    Me.ComboBox2.Left = Target.Left
    Me.ComboBox2 = Target
    Me.ComboBox2.Visible = True
    Me.ComboBox2.Activate
    'Me.ComboBox1.DropDown    ' ouverture automatique au clic dans la cellule (optionel)
  Else
     Me.ComboBox2.Visible = False
  End If
  If Not Intersect([d7:d35], Target) Is Nothing And Target.Count = 1 Then
    b = Range("liste_depots_bon_livraison")
    Me.ComboBox3.List = b
    Me.ComboBox3.Height = Target.Height + 3
    Me.ComboBox3.Width = Target.Width
    Me.ComboBox3.Top = Target.Top
    Me.ComboBox3.Left = Target.Left
    Me.ComboBox3 = Target
    Me.ComboBox3.Visible = True
    Me.ComboBox3.Activate
    'Me.ComboBox1.DropDown    ' ouverture automatique au clic dans la cellule (optionel)
  Else
    Me.ComboBox3.Visible = False
  End If

If Not Intersect(Target, Worksheets("LIVRAISON").Range("C59:D64")) Is Nothing Then
    Worksheets("LIVRAISON").Range("R12").Select
End If
   
    If Not Intersect(Target, Worksheets("LIVRAISON").Range("J1:P6")) Is Nothing Then
        Worksheets("LIVRAISON").Range("R12").Select
    End If
       
        If Not Intersect(Target, Worksheets("LIVRAISON").Range("A1:B6")) Is Nothing Then
            Worksheets("LIVRAISON").Range("R12").Select
        End If

            If Not Intersect(Target, Worksheets("LIVRAISON").Range("E2:E4")) Is Nothing Then
                Worksheets("LIVRAISON").Range("R12").Select
            End If

                If Not Intersect(Target, Worksheets("LIVRAISON").Range("C2:H2")) Is Nothing Then
                    Worksheets("LIVRAISON").Range("R12").Select
                End If

                    If Not Intersect(Target, Worksheets("LIVRAISON").Range("B6:I6")) Is Nothing Then
                        Worksheets("LIVRAISON").Range("R12").Select
                    End If

                        If Not Intersect(Target, Worksheets("LIVRAISON").Range("D1:I1")) Is Nothing Then
                            Worksheets("LIVRAISON").Range("R12").Select
                        End If

                            If Not Intersect(Target, Worksheets("LIVRAISON").Range("R1:R2")) Is Nothing Then
                                Worksheets("LIVRAISON").Range("R12").Select
                            End If
                               
                                If Not Intersect(Target, Worksheets("LIVRAISON").Range("F37:I37")) Is Nothing Then
                                    Worksheets("LIVRAISON").Range("R12").Select
                                End If
                               
                                    If Not Intersect(Target, Worksheets("LIVRAISON").Range("I46")) Is Nothing Then
                                        Worksheets("LIVRAISON").Range("R12").Select
                                    End If
                                   
                                        If Not Intersect(Target, Worksheets("LIVRAISON").Range("J7:J35")) Is Nothing Then
                                            Worksheets("LIVRAISON").Range("R12").Select
                                        End If
                                            If Not Intersect(Target, Worksheets("LIVRAISON").Range("N1:N1")) Is Nothing Then
                                                Worksheets("LIVRAISON").Range("R12").Select
                                            End If
                                              If Not Intersect(Target, Worksheets("LIVRAISON").Range("T7:AN35")) Is Nothing Then
                                                  Worksheets("LIVRAISON").Range("R12").Select
                                               End If
                                                If Not Intersect(Target, Worksheets("LIVRAISON").Range("E5")) Is Nothing Then
                                                    Worksheets("LIVRAISON").Range("R12").Select
                                                 End If
                                                    If Not Intersect(Target, Worksheets("LIVRAISON").Range("I6:I35")) Is Nothing Then
                                                        Worksheets("LIVRAISON").Range("R12").Select
                                                     End If
                                                
End Sub

' code pour avertirtissement de doublon dans la colonne "C"

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim Colonne As Integer
    Dim Adresse As String
   
    'On sort si plus d'une cellule a été modifiée
    If Target.Count > 1 Then Exit Sub
    'On sort si la cellule modifiée est vide
    If Target.Value = "" Then Exit Sub
   
    'Définit la colonne à vérifier (1=Colonne A, 2=colonne B ...etc...)
    Colonne = 3
         
    'Vérifie si c'est la colonne cible a été modifiée
    If Target.Column = Colonne Then
   
        'Recherche si la nouvelle donnée existe déjà dans la colonne.
        Adresse = Columns(Colonne).Find(What:=Target.Value, After:=Target.Offset(1, 0), LookAt:=xlWhole, _
            SearchDirection:=xlNext).Address
           
        'Si l'adresse de cellule trouvée ne correspond pas à la cellule modifiée, cela
        'signifie qu'il y a un doublon dans la colonne.
        If Adresse <> Target.Address Then
       
            MsgBox "La Réference '" & Target & "' Déjà saisie ", vbExclamation
           
        End If
    End If
   
End Sub




Sub masquer_barre()
ActiveWindow.DisplayWorkbookTabs = False
End Sub

bennisay · 23 Septembre 2016

reb
C est ce que j ai comme message

" Nom ambigu détecté
Worksheet change"

pierrejean · 23 Septembre 2016

RE
a tester :

mettre ces 3 lignes
If Target.Address = "$B$1" Then Range("A3").Select
If Target.Address = "$B$5" Then Range("A6").Select
If Target.Address = "$B$6" Then Range("A7").Select

tout de suite apres le
Private Sub Worksheet_Change(ByVal Target As Excel.Range) existant

bennisay · 24 Septembre 2016

BONJOUR LE FORUM pierrejean Robert
Je suis ps un expert dans les VBA donc j ai ps reussis a faire fonctionner le code . le probleme c est que le fichier est plein de codes donc et de fonctions du meme les cellules que je voulu mettre la celections contiennent des listes deroulantes donc le code ne fonctionne ps comme prevus sur mon fichier d exemple pour cela je vous fait part de mon fichier d origine comme ca vous allez savoir comment ce se passe
et merci infiniment

pierrejean · 24 Septembre 2016

Re

A tester (nb fonctionne si valeur changée)

Effectuez une recherche sur Excel Downloads...

DEPLACEMENT AVEC TABULATION

bennisay

XLDnaute Occasionnel

pierrejean

XLDnaute Barbatruc

Robert

XLDnaute Barbatruc

bennisay

XLDnaute Occasionnel

Robert

XLDnaute Barbatruc

bennisay

XLDnaute Occasionnel

bennisay

XLDnaute Occasionnel

pierrejean

XLDnaute Barbatruc

Robert

XLDnaute Barbatruc

bennisay

XLDnaute Occasionnel

bennisay

XLDnaute Occasionnel

bennisay

XLDnaute Occasionnel

pierrejean

XLDnaute Barbatruc

bennisay

XLDnaute Occasionnel

Pièces jointes

pierrejean

XLDnaute Barbatruc

Pièces jointes

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums