bennisay
XLDnaute Occasionnel
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 .
Et merci pour votre aides
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 IfEt merci pour votre aides
