Afficher le devis en cours
Bonjour à tous,
Sur l'onglet Honda, j'ai un bouton "Afficher le devis" CB_AfficherLeDevis_Click() que j'essaye de faire fonctionner.
Le bouton à sa droite permet de sélectionner un devis. Une fois sélectionné, le N° du devis s'affiche dans la TextBoxDevisEnCours que vous voyez.
Les Devis sont dans le TableauDevis qui est dans l'onglet Devis.
J'ai essayé de faire ce code en m'inspirant de ce qui existe dans la feuille TousLesDevis et de son bouton AfficherCeDevis ( CB_AfficherDevis_Click() )
Voici ce que j'ai essayé de faire, qui évidemment bugue sur la ligne.
En fait, le problème est que je n'arrive pas à comprendre comment se font les tableaux "Array" et comment les gérer.
r = Application.IfError(Application.Match(MonDevis, Range("TableauDevis[NoDevis]"), 0), 0) ' la ligne du devis (enfin, c'est ce que je voulais... )Private Sub CB_AfficherLeDevis_Click()
'**************************
' ouvre le devis affiché dans la TextBoxDevisEnCours de l'onglet Honda
'**************************
' // ouvre le devis sélectionné en détail dans le formulaire DetailsDuDevis
Dim C As Range, MonDevis, r, Arr, aOut, ptr, i, MonTotal
MonDevis = Me.TextBoxDevisEnCours 'le numero du devis
If MonDevis = "" Then
MonDevis = MsgBox("Aucun devis sélectionné !", vbCritical)
Exit Sub
Else
With MonDevis
r = Application.IfError(Application.Match(MonDevis, Range("TableauDevis[NoDevis]"), 0), 0) ' la ligne du devis (enfin, c'est ce que je voulais... )
If r = 0 Then
MsgBox "Aucun devis sélectionné !": Exit Sub
Else
Arr = Range("TableauDevis").Rows(r).Value2 'contenu de la ligne de ce Devis
End If
End With
Arr = Array(Range("TableauDevis").Rows(r).Value2) 'contenu de la ligne de ce Devis
DetailsDuDevis.TextBoxNomPrenom = Arr(1, 1) ' NomPrenom Nom et Prénom
DetailsDuDevis.TextBoxNoDevis = Arr(1, 3) ' NoDevis N° du devis
DetailsDuDevis.TextBoxTitreDevis = Arr(1, 4) ' TitreDevis ' corrigé le 24/08/2025 papicx
DetailsDuDevis.OptionButton1 = (StrComp(Arr(1, 2), "Ouvert", 1) = 0) ' bouton "ouvert"
DetailsDuDevis.OptionButton2 = (StrComp(Arr(1, 2), "Verrouillé", 1) = 0) ' bouton "Verrouillé"
' DetailsDuDevis.TextBoxAdrCPVille = [TableauClients].Item(pos, 2) & " " & [TableauClients].Item(pos, 3) & " " & [TableauClients].Item(pos, 4) ' adresse, CP, ville
' DetailsDuDevis.TextBoxMotoCoulImmat = [TableauClients].Item(pos, 5) & " " & [TableauClients].Item(pos, 6) & " " & [TableauClients].Item(pos, 7) ' Moto, couleur, immatriculation
r = 0
For i = 7 To UBound(Arr, 2) Step 6 'les colonnes des ReferenceXX ' modifié le 5 en 6 car les colonnes "designation" ont été ajoutées au TableauDevis papicx le 22/07/2026
r = r - (Len(Arr(1, i)) > 0) 'nombre non-vide
Next
ReDim aOut(1 To Application.max(1, r), 1 To 7) 'préparer une matrice la plus adaptée pour tous ces références utiles changer le 6 en 7 papicx le 20/07/2026
For i = 7 To UBound(Arr, 2) Step 6 'boucler toutes les colonnes "Referencexx" les colonnes "designation" ont été ajoutées au TableauDevis papicx le 22/07/2026
If Arr(1, i) <> "" Then 'référence connue
ptr = ptr + 1 'augmenter pointer
aOut(ptr, 1) = Arr(1, i) 'reference
aOut(ptr, 2) = Arr(1, i + 3) ' Adap01
aOut(ptr, 3) = Arr(1, i + 1) ' designation
aOut(ptr, 4) = Arr(1, i + 4) ' Qu01
aOut(ptr, 5) = Arr(1, i + 5) ' Prix01
aOut(ptr, 6) = aOut(ptr, 4) * aOut(ptr, 5) ' calcul du total par référence (prix X quantité)
MonTotal = MonTotal + aOut(ptr, 6) ' total du devis
End If
Next
MonTotal = Format(MonTotal, "# ##0.00 €") ' formatage du total du devis, attention le mettre en dehors de la boucle !!! papicx 24/08/2025 ajout du € le 28/08/2025
With DetailsDuDevis.ListBoxDetailDuDevis
If ptr = 0 Then
.Clear
Else
.List = aOut ' coller matrice dans listbox
For i = ptr + 1 To UBound(aOut) ' n'affiche pas les lignes sans référence
.RemoveItem ptr
Next
FormaterNombreDetail ' la liste est remplie, on formate les totaux des devis
End If
End With
DetailsDuDevis.TextBoxTotal = MonTotal
DetailsDuDevis.Show
End If
End SubMerci de votre aide bienveillante.
Bonjour le fil,
papicx, il y a combien de temps que vous êtes sur ce ficher ?
Franchement vous cherchez le bâton pour vous faire battre.
Question avez-vous accès à l'application Access, si OUI basculez dessus vous irez beaucoup plus vite pour finaliser votre projet et si vous gérez bien vos tables sans pratiquement pas de code.
Bon ceci dit :
Pour arriver au résultat voulu vous devez quand même faire des modifications assez importantes :
- Le formulaire "DetailsDuDevis" ne doit avoir qu'une seule fonction afficher les détails de ce devis. exit donc le bouton changer de devis.
- Vous ne devez pas pouvoir le modifier si celui-ci est verrouillé.
- Votre liste de devis tableau "TableauDevis" ne dois pas comporter les lignes pour les pièces c'est trop limitatif. Préférez travailler avec deux tableaux qui seront en relation avec un index de ligne (comme dans Access)
-
Sinon j'ai remarqué que certains contrôle n'avaient pas de colonne équivalente dans la table devis mais dans la table contact (ex:TextBoxAdrCPVille) tout cela va compliquer la maintenance du code.
Bon votre bouton "Afficher ce devis" sur la feuille "Devis" doit faire quelques tests :
- Vérifier que le tableau contient des lignes.
- Vérifier que la cellule active est bien dans le tableau
- Vérifier que la colonne "NoDevis" contient bien des données
- Si OUI récupérer cette ligne
- La transmettre au formulaire DetailsDuDevis"
- Remplir le formulaire avec les données de la ligne
Public Sub AfficherDevis(ByVal celluleActuelle As Range)
'// Teste la présence de la feuille. Pas obligatoire si la procédure est lancée depuis la feuille elle-même
Dim itemSheet As Worksheet
Set itemSheet = xlTools.GetSheetByCodeName(GlobalConsts.SHEET_DEVIS_NAME)
If itemSheet Is Nothing Then
MsgBox "Impossible d'initialiser la feuille ""Devis""" & vbCrLf _
& "Vous l'avez peut-être supprimée ou renommée !" & vbCrLf _
& "" & vbCrLf _
& "L'action va être annulée.", vbOKOnly Or vbInformation, "Gestion des feuilles"
Exit Sub
End If
'// Teste si le tableau est présent sur la feuille
Dim lstO As ListObject
Set lstO = xlTools.GetListObject(GlobalConsts.TAB_DEVIS_NAME)
If lstO Is Nothing Then
MsgBox "Impossible de trouver le tableau " & GlobalConsts.TAB_DEVIS_NAME & "." & vbCrLf _
& "Vous l'avez peut-être supprimé ou renommé." & vbCrLf _
& "" & vbCrLf _
& "L'action va être annulée !", vbOKOnly Or vbInformation, "Gestion des tableaux"
Exit Sub
End If
'// teste si la colonne "No Devis" est bien présente
Dim IndexColumn As Long
On Error Resume Next
IndexColumn = lstO.ListColumns(GlobalConsts.TAB_DEVIS_NUMERO_NAME).Index
On Error GoTo 0
If IndexColumn = 0 Then
MsgBox "Impossible de trouver la colonne " & GlobalConsts.TAB_DEVIS_NUMERO_NAME & "." & vbCrLf _
& "Vous l'avez peut-être supprimée ou renommée." & vbCrLf _
& "" & vbCrLf _
& "L'action va être annulée !", vbOKOnly Or vbInformation, "Gestion des tableaux."
Exit Sub
End If
'// Teste si la table contient des lignes
If lstO.ListRows.Count = 0 Then
MsgBox "Le tableau de devis ne contient aucune lignes." & vbCrLf _
& "" & vbCrLf _
& "L'action va être annulée", vbOKOnly Or vbInformation, "Gestion des tableaux."
Exit Sub
End If
'// teste si la cellule active est dans une des lignes du tableau
With lstO
If Not Intersect(lstO.DataBodyRange, celluleActuelle) Is Nothing Then
'// Calcul de l'index de ligne dans le tableau
Dim rowIndex As Long
rowIndex = celluleActuelle.Row - lstO.DataBodyRange.Row + 1
Dim itemRow As ListRow
Set itemRow = lstO.ListRows(rowIndex)
If Not itemRow Is Nothing Then
'// On affiche le formulaire en lui passant la ligne en référence
With DetailsDuDevisForm
Set .LigneDevis = itemRow
.Show
End With
Unload DetailsDuDevisForm
Else
MsgBox "Oupss nous avons rencontré un problème au chargement du devis " & GlobalConsts.TAB_DEVIS_NUMERO_NAME & ".", vbOKOnly Or vbExclamation, "Gestion des tableaux."
End If
Else
MsgBox "Vous devez sélectionner une ligne dans le tableau [" & lstO.Name & "], avant de pouvoir afficher le devis.", vbOKOnly Or vbInformation, "Gestion des devis."
Exit Sub
End If
End With
End SubCette procédure appelle deux fonctions "GetSheetByCodeName()" et "GetListObject()" elles se trouve dans le module "XlTools". La première sert à récupérer une feuille par son CodeName si trouvé elle renvoie l'objet Feuille sinon elle renvoie Nothing. La seconde fait pareil pour un objet ListObject.
J'ai aussi ajouter des constantes dans le module "GlobalConsts" pour éviter de retaper le nom des colonnes etc.
J'ai ajouter une propriété au formulaire pour lui faire passer la ligne qui doit être éditée
Vous remarquerez que je ne fais pas un Unload sur le bouton "Fermer" du formulaire, si vous regardez bien le code :
'...
'...
If Not itemRow Is Nothing Then
'// On affiche le formulaire en lui passant la ligne en référence
With DetailsDuDevisForm
Set .LigneDevis = itemRow
.Show
End With
Unload DetailsDuDevisForm
Else
MsgBox "Oupss nous avons rencontré un problème au chargement du devis " & GlobalConsts.TAB_DEVIS_NUMERO_NAME & ".", vbOKOnly Or vbExclamation, "Gestion des tableaux."
End If
'...
'...On affiche le formulaire, si depuis celui-ci on le cache "Me.Hide" alors la main est redonnée au code appelant et c'est lui qui le supprime de la mémoire.
Je n'ai pas traité le remplissage de la zone de liste comme déjà dit je trouve que cette façon de faire est trop limitée (Vous devriez travailler avec deux tableaux)
Pour conclure c'est une version minimaliste. Il y aurait beaucoup de choses à changer dans ce classeur à commencer par toutes ces variables publiques qui à mon sens ne peuvent que poser des problèmes.
hello,
je plussoie ce que dit Jean-Paul
papicx, il y a combien de temps que vous êtes sur ce ficher ?
Franchement vous cherchez le bâton pour vous faire battre.
Question avez-vous accès à l'application Access, si OUI basculez dessus vous irez beaucoup plus vite pour finaliser votre projet et si vous gérez bien vos tables sans pratiquement pas de code.
Excel c'est un tableur, lui faire prendre le role de gestionnaire de base de données c'est se compliquer la vie.
Certes Access va demander un temps d'adaptation, mais pas forcément autant que ce que vous passer à bidouiller le VBA.
Bon courage