Modification code vba

bennisay à dit:

Bonjour le forum
j ai un code VBA que je vais vous le copier
j aimerai en ajouter un code " Message box"
le problème c est que j ai pas réussi a l intégrer dans l ensembles des codes je reçois des erreurs.
Voici le code globale ; et dedans le code impression ou je veux insérer un autre code que je mettrai a la fin .

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([H4:H5], target) Is Nothing Then
Application.OnKey Key:="~", procedure:="retour_colonneC2"
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:I38")) 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
                                                        If Not Intersect(target, Worksheets("LIVRAISON").Range("Q17:R18")) 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
 

Le code que j aimerai insérer c est pour bloquer l impression si la cellule    "AV5"= 1 et recevoire le message box :MsgBox ("ERREUR ! : CLIENT NON AUTORISE AU CREDIT . ANNULATION BON LIVRAISON")


E

Code:

If Application.WorksheetFunction.CountA(oSh1.Range("AV5")) = 1 Then    'teste le remplissage de la celulle h4
        MsgBox ("ERREUR ! : CLIENT NON AUTORISE AU CREDIT . ANNULATION BON LIVRAISON"), vbInformation
        Exit Sub
         End If

Et merci pour votre aides

Cliquez pour agrandir...