Afficher le devis en cours

Question

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&#91;NoDevis&#93;"), 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&#91;NoDevis&#93;"), 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 = &#91;TableauClients&#93;.Item(pos, 2) & " " & &#91;TableauClients&#93;.Item(pos, 3) & " " & &#91;TableauClients&#93;.Item(pos, 4) ' adresse, CP, ville ' DetailsDuDevis.TextBoxMotoCoulImmat = &#91;TableauClients&#93;.Item(pos, 5) & " " & &#91;TableauClients&#93;.Item(pos, 6) & " " & &#91;TableauClients&#93;.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)) &gt; 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) &lt;&gt; "" 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 Sub Merci de votre aide bienveillante...

Jean-Paul · Answer

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 Voici la procédure qui va faire cela : 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 &#91;" & lstO.Name & "&#93;, avant de pouvoir afficher le devis.", vbOKOnly Or vbInformation, "Gestion des devis." Exit Sub End If End With End Sub Cette 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...

Nain porte koi · Answer

Je plussoie ce que dit Jean-Paul 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...

Jean-Paul · Answer

Papicx , Quand vous dites : Je suis un peu étonné car comme dis dans mon précédent post je ne gère pas la zone de liste. Donc je ne vois pas comment elle pourrait s'allonger. Vous avez sûrement fait un mix de plusieurs fichiers.....