Réutiliser des procédures depuis une autre feuille
Bonjour,
Depuis l'onglet Honda, on sélectionne une ligne par double clic,
Ce présente le formulaire (ModificationHonda) , en cliquant sur le bouton "Ajouter au devis en cours" (en plein milieu), je cherche à réemployer
des procédures (je ne sais pas si c'est le bon terme, corrigez moi svp) existantes :
• La première, CB_Sauvegarder, est dans ce formulaire,
• La seconde est dans une feuille (Feuil3 "Honda") , CB_AjouterACeDevis_Click() ... qui est en cours d'élaboration.
Ce serait quoi le bon code ?
Voilà ce que j'ai commencé à faire (et essayé plein d'autres combinaisons), mais ça ne fonctionne pas.
NB : J'ai enlevé le "Private" du Sub CB_AjouterACeDevis_Click()
Le but de réemployer ces 2 codes VBA est d'éviter de les réécrire.
Merci d'avance de votre aide
Private Sub AjouterAuDevis_Click()
' // PROJET :
' // sauvegarde les modifications + ouvre le formulaire AjouterAuDevis pour sélectionner la pièce d'origine ou adaptable
' //
' CB_Sauvegarder ' papicx 29/08/2025
' Sheets("Honda").CB_AjouterACeDevis ' papicx 29/08/2025
Dim SHH
Set SHH = Sheets("Honda") ' papicx 29/08/2025
' .CB_AjouterACeDevis
End Sub
Salut papicx,
Par rapport au nom du fichier... BsAlv devrait pouvoir vous aider
Bonjour papicx,
Vous employez bien le bon terme
Comment faire : copiez les subs en question dans un Module (existant ou nouveau). Remplacez le mot clé Private par Public. Renommez-less en fonction de ce qu'ils font (ex. Public Sub AjouterDevisHonda()) Ensuite, dans votre feuille/formulaire, au lieu d'avoir tout le code là, vous remplacez par
Private Sub AjouterAuDevis_Click()
' appel du sub déplacé
AjouterDevisHonda
End Subc’est-à-dire que le clic va appeler le sub AjouterDevisHonda que nous venons de déplacer dans le module + rendu public (= accessible en dehors du module).
Enfin, maintenant, vous pouvez réutiliser votre code là où vous voulez de la même manière, par exemple si vous aviez un sub :
Public Sub FaireDesChosesCompliquees()
' code quelconque
AjouterDevisHonda ' réutilisation du sub
' autre code quelconque
End SubDe manière générale quand vous savez/sentez que vous allez devoir réutiliser une procédure, déplacez la dans un Module, et appellez-la.
Ok, merci bien, je vais faire ça.
edit 13h06
s = Me.Controls(aMaster(i, 4)).Value 'contenu du TB ou CBles "Me" doivent être remplacés par le nom du formulaire en entier, ici "ModificationHonda" à première vue.
edit 13h18
J'me disais bien que ça n'allait pas être si simple...
Comme vous pouvez le voir ci-dessous, j'ai modifié la ligne
' iLigne = Val(TextBoxNumLigne.Text) - .Range.Row ' quelle est la ligne à écraser (valeur de textboxnumligne)par
iLigne = Val(ModidficationHonda.TextBoxNumLigne.Text) - Tableau1.Range.Row ' quelle est la ligne à écraser (valeur de textboxnumligne)mais apparemment, ça n'est pas correct.
Voir le code complet
Sub SauvegarderHonda()
'***************************************************************
' bouton SAUVEGARDER
' TextBoxNumLigne.Text montre la ligne, mais il faut corriger pour savoir le "listrow"
' ce décalage est le numéro de la ligne des entêtes
'***************************************************************
Dim i, j, Ligne, c, c1, s, L, iLigne
aMaster = Range("tabel19").Value2 'mettre en mémoire les données du tableau "tabel19", donc les liens entre l'UF et le tableau "tableau1" de Honda
With Range("Tableau1").ListObject
' iLigne = Val(TextBoxNumLigne.Text) - .Range.Row ' quelle est la ligne à écraser (valeur de textboxnumligne)
'// ajout de ModificationHonda. et Tableau1 suite au déplacement du code du formulaire vers le module2 papicx 29/08/2025
iLigne = Val(ModidficationHonda.TextBoxNumLigne.Text) - Tableau1.Range.Row ' quelle est la ligne à écraser (valeur de textboxnumligne)
'attention ici dessus on a corrigé le numéro de la ligne vers le numéro du listrow *******************************************
If iLigne < 1 Or iLigne > .ListRows.Count Then ' ligne n'est pas dans le tableau
MsgBox "erreur avec le nombre dans TextBoxNumLigne : " & TextTextBoxNumLigne.Text, vbCritical
Exit Sub
End If
Set c = .ListRows(iLigne).Range '***** maintenant c'est cette ligne existante à écraser dans le tableau "tableau1" *********
'***** met à jour les informations modifiées "tableau1" 24/06/2025 **********
For i = 1 To UBound(aMaster)
If Len(aMaster(i, 4)) > 0 And aMaster(i, 5) > 0 Then 'nom TB connu & lien avec tableau1
Set c1 = c.Cells(1, aMaster(i, 5)) 'la cellule pour coller ce contenu
'MsgBox c1.Address
If StrComp(aMaster(i, 4), "Image1", 1) = 0 Then 'le control est 'Image1"
'c1.Value = Me.Controls(aMaster(i, 4)).Tag
Else
s = ModidficationHonda.Controls(aMaster(i, 4)).Value 'contenu du TB ou CB
L = Len(s) 'son longueur
r = Application.IfError(Application.Match(aMaster(i, 2), Array("Date", "N", "Formule"), 0), 0) 'c'est un textbox date, numérique ou avec une formule ?
If r > 0 Then 'date, numérique ou formule
If r = 1 Then 'date
If L = 0 Then 'date inconnue
c1.Value = ""
Else
sp = Split(s, "/")
c1.Value = CLng(DateSerial(sp(2), sp(1), sp(0))) 'valeur long du date
End If
ElseIf r = 2 Then 'numérique
If L = 0 Then c1.Value = "" Else c1.Value = Val(Replace(Replace(s, " ", ""), ",", "."))
End If
Else 'les autres cas
If L = 0 Then c1.Value = "" Else c1.Value = s
End If
End If
End If
Next
' je veux montrer la ligne modifiée et une dizaine de lignes avant celle, mais si on était déjà au début, cela n'est pas toujours possible, alors première ligne du tableau
If c.Row > 10 Then Application.GoTo c.Cells(1).Offset(-10), 1 Else Application.GoTo .DataBodyRange.Cells(1), 1 ' cf le message de Bart du 13/07/2025
Application.GoTo c.Cells(1)
MsgBox "Les modifications ont bien été sauvegardées." & vbCrLf & vbCrLf & "Vous pouvez fermer le formulaire.", vbInformation, "MODIFICATIONS ENREGISTRÉES"
End With
Unload ModidficationHonda
voirEnd Submerci de votre aide
Ah oui, désolé je n'avais pas étudié le sub en détails. S'il y a des liens avec l'userform, alors il faut le passer en tant que paramètre à la fonction. Ci-après une proposition.
Sub générique
Sub MAJTableauHonda( _
ByVal UFSource As Object, _
ByVal nomTbl As String, _
ByVal nomTblMaster As String, _
ByVal ligneUF As Long _
)
Dim tbl As ListObject
Set tbl = Range(nomTbl).ListObject
Dim aMaster() As Variant
aMaster = Range(nomTblMaster).Value2
Dim ligneTbl As Long
ligneTbl = ligneUF - tbl.Range.Row
If ligneTbl < 1 Or ligneTbl > tbl.ListRows.Count Then
MsgBox "Erreur : numéro de ligne invalide (" & ligneUF & ")", vbCritical
Exit Sub
End If
Dim ligneCible As Range
Set ligneCible = tbl.ListRows(ligneTbl).Range
Dim i As Long
For i = 1 To UBound(aMaster)
Dim NomControle As String: NomControle = aMaster(i, 4)
Dim ColonneTableau As Long: ColonneTableau = aMaster(i, 5)
If Len(NomControle) > 0 And ColonneTableau > 0 Then
Dim CelluleCible As Range
Set CelluleCible = ligneCible.Cells(1, ColonneTableau)
If StrComp(NomControle, "Image1", vbTextCompare) = 0 Then
' Ignorer les images
Else
Dim ValeurControle As String
ValeurControle = UFSource.Controls(NomControle).Value
Dim TypeDonnee As Variant
TypeDonnee = Application.IfError(Application.Match(aMaster(i, 2), Array("Date", "N", "Formule"), 0), 0)
If TypeDonnee > 0 Then
Select Case TypeDonnee
Case 1 ' Date
If Len(ValeurControle) = 0 Then
CelluleCible.Value = ""
Else
Dim ComposantsDate As Variant
ComposantsDate = Split(ValeurControle, "/")
CelluleCible.Value = CLng(DateSerial(ComposantsDate(2), ComposantsDate(1), ComposantsDate(0)))
End If
Case 2 ' Numérique
If Len(ValeurControle) = 0 Then
CelluleCible.Value = ""
Else
CelluleCible.Value = Val(Replace(Replace(ValeurControle, " ", ""), ",", "."))
End If
End Select
Else
If Len(ValeurControle) = 0 Then
CelluleCible.Value = ""
Else
CelluleCible.Value = ValeurControle
End If
End If
End If
End If
Next i
If ligneCible.Row > 10 Then
Application.GoTo ligneCible.Cells(1).Offset(-10), True
Else
Application.GoTo tbl.DataBodyRange.Cells(1), True
End If
Application.GoTo ligneCible.Cells(1)
MsgBox "Les modifications ont bien été sauvegardées." & vbCrLf & vbCrLf & "Vous pouvez fermer le UFSource.", vbInformation
End SubAppel depuis l'UserForm
Private Sub AjouterAuDevis_Click()
MAJTableauHonda Me, "Tableau1", "tabel19", Val(Me.TextBoxNumLigne.Text)
Unload Me
End SubMerci Saboh12617, ça marche impeccable !
Je suis impressionné de voir que vous pouvez générer un code aussi complexe en qq minutes. Même avec des mois d'essais, je n'y parviendrais pas.
Un grand MERCI donc.
J'ai mis une bonne demi-heure à éplucher ton code pour le comparer à celui de Bart, essayer de contrôler qu'il ne manquait rien et, bien sûr, essayer de le comprendre. J'ai pris un bon mal de tête.
À mon sens, je pense qu'on devrait faire la même chose pour le code qui est présent dans la page Honda et qui concerne le bouton "Ajouter à ce devis".
En effet, j'envisage d'utiliser ce même code depuis le bouton "Ajouter au devis en cours" , AjouterAuDevis_Click() du formulaire ModifierHonda
Private Sub AjouterAuDevis_Click()
' // PROJET :
' // sauvegarde les modifications + ouvre le formulaire AjouterAuDevis pour sélectionner la pièce d'origine ou adaptable
' // la procédure est dans le Module2 papicx 29/08/2025
M_MAJTableauHonda Me, "Tableau1", "tabel19", Val(Me.TextBoxNumLigne.Text)
Unload Me
' M_AjouterACeDevis ' mmis en commentaire en prévision que le code soit opérationnel dans le module2 papicx 29/08/2025
End SubCe code est en cours d'élaboration.
Comme tu peux le voir, il me manque entre autre le moyen de "récupérer" la valeur de la ligne pour y faire correspondre les valeurs qui irons aux TextBox
Sub CB_AjouterACeDevis_Click()
' PROJET :
' si la TextBoxDevisEnCours est vide, => msg " aucun devis est sélectionné ! " et proposera d'ouvrir le formulaire TousLesDevis FAIT
' si la TextBoxDevisEnCours est renseignée, ce bouton ( AjouterACeDevis ) ouvrira le formulaire AjouterAuDevis (du TableauDevis) FAIT
' en ayant copié les informations de la ligne sélectionnée. ' en cours...
' ceci permettra de choisir entre une pièce adaptable (et donc son prix) ou Honda d'origine (et son prix) et ajuster la quantité.
' voir le formulaire AjouterAuDevis
' M_AjouterACeDevis
'// la procédure suivante est à déplacer dans le Module2 et à inclure dans M_AjouterACeDevis
Dim s, r, t, SH
Set SH = Sheets("Devis") ' attention dans le module d'une feuille, il faut ajouter à la feuille la plage d'une autre feuille !!!
s = Sheets("Honda").TextBoxDevisEnCours.Text 'le contenu du Textbox "Devis en cours"
' t = ' ligne sélectionnée dans le Tableau1
If s = "" Then
If MsgBox("Aucun devis n'est sélectionné." & vbLf & "Veuillez sélectionner un devis.", vbExclamation, "Devis à sélectionner") = vbYes Then TousLesDevis.Show
Else
r = Application.IfError(Application.Match(s, SH.Range("TableauDevis[NoDevis]"), 0), 0) 'position dans le TS "TableauDevis"
If r = 0 Then
MsgBox "devis inconnu": Exit Sub
Else
With AjouterAuDevis 'cet userform
' // récupère les valeurs du TableauDevis
.TextBoxNomPrenom = SH.Range("TableauDevis[NomPrenom]").Cells(r, 1).Value2 'nom correspondant
.TextBoxNoDevis = s
.TextBoxTitreDevis = SH.Range("TableauDevis[Titredevis]").Cells(r, 1).Value2 'titre correspondant BsAlv 28/08/2025
' // récupère les valeurs du Tableau1 (onglet Honda)
.TextBoxQu = Range("Tableau1[Qu]").Cells(t, 1).Value2 ' quantité prévue est présent à titre indicatif sur le formlaire
.TextBoxDesignation = Range("Tableau1[designation]").Cells(t, 1).Value2
.TextBoxRefOriginale = Range("Tableau1[Honda_Origine]").Cells(t, 1).Value2
.TextBoxRefAlternative = Range("Tableau1[Ref_Alt]").Cells(t, 1).Value2
.TextBoxNewRefHonda = Range("Tableau1[New_Ref_Honda]").Cells(t, 1).Value2
.TextBoxDPCTTC = Range("Tableau1[DPC_TTC]").Cells(t, 1).Value2
.TextBoxRefAdaptable = Range("Tableau1[REF_HG]").Cells(t, 1).Value2
.TextBoxFournisseur = Range("Tableau1[Fournisseur]").Cells(t, 1).Value2
.TextBoxTTC€Adapable = Range("Tableau1[TTC_€_adapt]").Cells(t, 1).Value2
.Show
End With
End If
End If
End SubMerci de votre aide
Salut Papicx,
J'ai mis une bonne demi-heure à éplucher ton code pour le comparer à celui de Bart, essayer de contrôler qu'il ne manquait rien et, bien sûr, essayer de le comprendre. J'ai pris un bon mal de tête.
Le code essentiellement est celui de Bart. J'ai peut-etre renommé quelques variables pour m'y retrouver mais la logique de fonctionnement est la sienne. Ce que l'on fait en fait c'est que l'on donne à MAJTableauHonda le paramètre "Me" depuis l'UserForm, donc c’est-à-dire lui-même. Cela permet à la fonction MAJTableauHonda d'accéder aux différents champs de l'UF (textbox, listbox, etc) "depuis l'extérieur".
Je dois dire que j'ai du mal à suivre ta demande car je suis complètement étranger au projet. Cependant si j'ai bien compris ton dernier message, tu souhaites déplacer la logique présente dans CB_AjouterACeDevis_Click pour pouvoir la réutiliser (comme on vient de le faire avec MAJTableauHonda. Je te donne ci-après une proposition de code, à tester :
Dans module2, ajouter :
Sub M_AjouterACeDevis(ByVal NoDevis As String, ByVal LigneTableau1 As Long)
Dim SH As Worksheet
Set SH = Sheets("Devis")
Dim r As Variant
r = Application.IfError(Application.Match(NoDevis, SH.Range("TableauDevis[NoDevis]"), 0), 0)
If r = 0 Then
MsgBox "Devis inconnu", vbExclamation
Exit Sub
End If
With AjouterAuDevis '<- je n'ai pas bien compris de quel UF il s'agitce n'est pas vraiment "Cet uf" mais plutot un autre
' Infos du devis
.TextBoxNomPrenom = SH.Range("TableauDevis[NomPrenom]").Cells(r, 1).Value2
.TextBoxNoDevis = NoDevis
.TextBoxTitreDevis = SH.Range("TableauDevis[Titredevis]").Cells(r, 1).Value2
' Infos de la pièce (Tableau1)
Dim Tbl As ListObject
Set Tbl = Sheets("Honda").ListObjects("Tableau1")
If LigneTableau1 < 1 Or LigneTableau1 > Tbl.ListRows.Count Then
MsgBox "Ligne de pièce invalide", vbExclamation
Exit Sub
End If
Dim Ligne As Range
Set Ligne = Tbl.ListRows(LigneTableau1).Range
.TextBoxQu = Ligne.Columns("Qu").Value
.TextBoxDesignation = Ligne.Columns("designation").Value
.TextBoxRefOriginale = Ligne.Columns("Honda_Origine").Value
.TextBoxRefAlternative = Ligne.Columns("Ref_Alt").Value
.TextBoxNewRefHonda = Ligne.Columns("New_Ref_Honda").Value
.TextBoxDPCTTC = Ligne.Columns("DPC_TTC").Value
.TextBoxRefAdaptable = Ligne.Columns("REF_HG").Value
.TextBoxFournisseur = Ligne.Columns("Fournisseur").Value
.TextBoxTTC€Adapable = Ligne.Columns("TTC_€_adapt").Value
.Show
End With
End SubEt tu modifies CB_AjouterACeDevis_Click ainsi :
Private Sub CB_AjouterACeDevis_Click()
Dim NoDevis As String
NoDevis = Sheets("Honda").TextBoxDevisEnCours.Text
If NoDevis = "" Then
If MsgBox("Aucun devis n'est sélectionné." & vbLf & "Veuillez sélectionner un devis.", vbExclamation, "Devis à sélectionner") = vbYes Then
TousLesDevis.Show
End If
Exit Sub
End If
' Déterminer la ligne sélectionnée dans le tableau "Tableau1"
Dim LigneSelectionnee As Long
LigneSelectionnee = ActiveCell.Row - Range("Tableau1").ListObject.Range.Row
If LigneSelectionnee < 1 Or LigneSelectionnee > Range("Tableau1").ListObject.ListRows.Count Then
MsgBox "Aucune ligne valide sélectionnée dans le tableau Honda.", vbExclamation
Exit Sub
End If
' Appel de la procédure centralisée dans Module2
M_AjouterACeDevis NoDevis, LigneSelectionnee
End SubEn espérant que ce soit bien ce que tu attends.
Bonjour à tous,
La portée et l'emplacement des procédures ? Une bonne question.
La question est ? Où vais-je avoir besoin de cette procédure ? Au niveau du Formulaire Honda ? Si la réponse est oui alors l'emplacement de la procédure au niveau du module du formulaire et plus que suffisant. Avec une déclaration en Private. Maintenant prenons le cas d'une fonction telle que celle-ci :
'@Description "Change le nom de la fenêtre."
Public Function SetMeCaption(Optional ByVal Value As String = vbNullString) As String
With ThisWorkbook
Dim ShortName As String
ShortName = Left$(.Name, InStrRev(.Name, ".", -1, vbTextCompare) - 1)
End With
ShortName = Replace( _
Expression:=ShortName, _
Find:="Valtrase - ", _
Replace:=vbNullString, _
Start:=1, Count:=1, _
Compare:=vbTextCompare _
)
ShortName = Trim$(ShortName) & IIf(Value > vbNullString, " - ", vbNullString) & Value
SetMeCaption = ShortName
End FunctionCette fonction peut-être appelée pour plusieurs formulaire ou autres. Dans ce cas la fonction sera mise dans un module standards et déclarée en public.
Il est primordial de déclarer les variables, procédures, et fonctions au plus près de leurs utilisations.
Merci pour vos réponses, je les étudierai plus tard dans la soirée ou demain matin.
Je vous ferai un retour, mais déjà Saboh12617, c'est bien ça dont je parlais.
Je testerai ta proposition.
@Jean-Paul,
Je n'ai pas compris grand chose à ton code. Peux tu développer stp ?
Comment appeler cette fonction ? et à quoi sert elle vraiment ?
commençons par lever un doute : qu'appelle tu fenêtre ? (pour être certain qu'on parlera de la même chose).
Merci de vos lumières toujours plus aveuglantes
Bonjour Saboh12617
J'ai appliqué les codes dans mon fichier et ça bloque à ce niveau.
J'ai bien essayé de résoudre, mais sans succès.
curieusement, la première ligne passe mais même en mettant en commentaire les lignes suivantes, la quantité ne s'affiche pas à l'ouverture du formulaire.
J'ai tout de même appliqué les ajustements pour avoir les prix avec les 2 décimales.
Je ne sais pas si c'est propre comme code, mais ça fonctionnait avec l'ancienne procédure.
dis moi si c'est propre comme code, stp.
'// .TextBoxDPCTTC = Ligne.Columns("DPC_TTC").Value
' // essai de mise au format des prix avec les 2 décimales papicx 03/09/2025
DPCTTC = Ligne.Columns("DPC_TTC").Value
.TextBoxDPCTTC = Format(DPCTTC, "#,##0.00")
' .../... ( 2 lignes supprimées pour plus de clarté dans le forum)
'// .TextBoxTTC€Adapable = Ligne.Columns("TTC_€_adapt").Value
' // essai de mise au format des prix avec les 2 décimales papicx 03/09/2025
TTC€Adapable = Ligne.Columns("TTC_€_adapt").Value
.TextBoxTTC€Adapable = Format(TTC€Adapable, "#,##0.00")Merci de votre aide.
Salut Papicx,
Excuse moi je t'ai donné un peu du n'importe quoi pour cette partie du code. En fait comme on travaille avec la ligne extraite du tableau (variable "Ligne" = range de 1 ligne), on n'a plus les en-tete du tableau correspondant. Je te propose donc la révision suivante, certes un peu plus longue, mais c'est pour y voir plus clair :
D'abord on fait une liste des numéros de colonne correspondant dans la table (attention, vu qu'elle commence en colonne B, 1 = B) et ensuite on utilise ces valeurs pour peupler les textbox. Dans mon code précédent, supprime le bloc ci-après et remplace le comme indiqué ci-dessous :
Dim Ligne As Range
Set Ligne = Tbl.ListRows(LigneTableau1).Range
' TOUT CE QUI EST COMMENTE EST A SUPPRIMER
'.TextBoxQu = Ligne.Columns("Qu").Value
'.TextBoxDesignation = Ligne.Columns("designation").Value
'.TextBoxRefOriginale = Ligne.Columns("Honda_Origine").Value
'.TextBoxRefAlternative = Ligne.Columns("Ref_Alt").Value
'.TextBoxNewRefHonda = Ligne.Columns("New_Ref_Honda").Value
'.TextBoxDPCTTC = Ligne.Columns("DPC_TTC").Value
'.TextBoxRefAdaptable = Ligne.Columns("REF_HG").Value
'.TextBoxFournisseur = Ligne.Columns("Fournisseur").Value
'.TextBoxTTC€Adapable = Ligne.Columns("TTC_€_adapt").Value
' UTILISER LA SOLUTION SUIVANTE
Dim colQu As Long: colQu = 2
Dim colDesi As Long: colDesi = 7
Dim colHondaOr As Long: colHondaOr = 1
Dim colRefAlt As Long: colRefAlt = 38
Dim colRefHonda As Long: colRefHonda = 3
Dim colDPCTTC As Long: colDPCTTC = 16
Dim colRefHG As Long: colRefHG = 31
Dim colFourn As Long: colFourn = 36
Dim colAdapt As Long: colAdapt = 62
.TextBoxQu = Ligne.Cells(1, colQu).Value
.TextBoxDesignation = Ligne.Cells(1, colDesi).Value
.TextBoxRefOriginale = Ligne.Cells(1, colHondaOr).Value
.TextBoxRefAlternative = Ligne.Cells(1, colRefAlt).Value
.TextBoxNewRefHonda = Ligne.Cells(1, colRefHonda).Value
.TextBoxDPCTTC = Ligne.Cells(1, colDPCTTC).Value
.TextBoxRefAdaptable = Ligne.Cells(1, colRefHG).Value
.TextBoxFournisseur = Ligne.Cells(1, colFourn).Value
.TextBoxTTC€Adapable = Ligne.Cells(1, colAdapt).Value
.ShowNota : pense a double check les numéros de colonne, j'ai essayé de ne pas me tromper mais on n'est jamais à l'abris d'erreurs sur d'aussi grands tableaux.
re, salut saboh12617,
il y a 2 manières presque similaires, mais le point de départ est différent
- comme saboh12617 l'a fait, utiliser le listrow et puis chercher la bonne colonne
- oubien directement la bonne colonne et puis utiliser la ligne, par exemple
.TextBoxDesignation = Range("Tableau1[designation]").Cells(LigneTableau1, 1).ValueRange("Tableau1[designation]") est la bonne colonne (et s'on supprime/ajoute/déplace des colonnes, cela s'adapte tout seul) et "LigneTableau1" vous dit la bonne ligne
je l'écris ici, je ne savais pas l'endroit où vous appliquez cela dans le fichier ...
Salut @Bart,
Oui, si la structure de votre tableau est amenée à bouger (changement de l'ordre des colonnes), l'approche initiale de Bart ne nécessite aucune modification, alors qu'il faudra réindexer les colonnes dans mon dernier message.
A vrai dire, c'est peut-être l'approche à privilégier. Attention par contre à ne pas renommer vos colonnes & tableaux !
Je pense que les noms, pour ce projet, sont assez "fixe" et les colonnes aussi, donc pour le moment, le choix est plutôt sentimental
Bonsoir à vous deux.
Merci pour ces propositions.
Sans vouloir vexer Saboh12617, je vais opter pour la méthode de Bart. Je lui adjoindrai néanmoins des commentaires pour m'y retrouver plus tard, si besoin...
Je vais me faire un mémo à part qui me servira de tutoriel.
J'ai a peu près cette méthode à appliquer pour le tableau devis...
Ce que je ne comprends pas c'est comment est défini LigneTableau1 ???
Je vois à un moment que si c'est en dehors du tableau, on a un message d'erreur, mais c'est tout.
Est ce que "Ligne" suivi du nom du tableau ferait parti du langage vba comme sub range Cells etc ?
Merci de vos lumières chaleureuses.
Bonjour papicx,
Aucun soucis !
Pour LigneTableau1, ce n'est pas le language VBA, c'est une variable :
On a le nouveau Sub que je vous ai donné Sub M_AjouterACeDevis(ByVal NoDevis As String, ByVal LigneTableau1 As Long) qui prend 2 arguments : le Numéro de Devis NoDevis et le numéro de ligne du tableau LigneTableau1.
Ces 2 infos sont nécessaires pour pouvoir appeler la procédure depuis divers boutons, ce qui était votre question initiale. Donc quand on appelle M_AjouterACeDevis, on doit donner ces 2 infos. C'est ce qui est fait ici :
Private Sub CB_AjouterACeDevis_Click()
' [...] code de calcul & validation des variables NoDevis et LigneSelectionnee
' Appel de la procédure centralisée dans Module2
M_AjouterACeDevis NoDevis, LigneSelectionnee
' si vous préférez, on pourrait aussi écrire
' M_AjouterACeDevis NoDevis:=NoDevis, LigneTableau1:=LigneSelectionnee
End SubVous voyez que la variable LigneSelectionnee est donnée à M_AjouterACeDevis comme valeur pour LigneTableau1.
Donc en gros le fonctionnement est :
CB_AjouterACeDevis_Click -> calcule LigneSelectionnee -> le donne à M_AjouterACeDevis (à ce moment là, le numéro de ligne sélectionnée est "renommé" (ou plutôt copié dans) LigneTableau1) -> LigneTableau1
En espérant que cela soit un peu plus clair.
Bonjour Saboh12617
OUI, merci, j'y vois un poil plus clair avec vos explications. Merci beaucoup même.
Pouvez vous me décrypter la ligne suivante, svp ?
LigneSelectionnee = ActiveCell.Row - Range("Tableau1").ListObject.Range.RowCe que je crois comprendre, c'est ça (dites moi si je me trompe) :
LigneSelectionnee c'est la rangée où est la cellule active qui sélectionne la ligne entière.
En fait, j'aimerai savoir ce qu'implique ce signe " - " au milieu de cette ligne de code.
Mais si vous pouviez me traduire ça en "langage logique" et un poil plus académique, ça me ferait avancer dans ce noir obscur du langage VBA.
Le but est aussi de pouvoir la mémoriser, bien entendu.
Je viens d'appliquer la méthode de Bart et ça fonctionne.
Merci de vos lumières et de votre patience.
Il s'agit du calcul de la ligne sélectionnée dans le tableau. Un schéma vaut bien de longues explications :
Cela permet de passer du numéro de ligne "global" dans la feuille au numéro de ligne "local" dans le tableau. C'est celui qui nous intéresse puisque M_AjouterACeDevis en a besoin.
Une analogie avec, par exemple, les changements de repères que vous avez peut-être étudiés en mathématiques/géométrie.
Bonjour,
C'est effectivement plus clair avec un schéma. Merci bien.
J'ai essayé de faire une fonction pour pouvoir "basculer/revenir" du formulaire AjouterAuDevis vers le formulaire ModificationHonda , sans succès.
J'y ai passé l'après midi.
Le problème est le suivant :
Le devis est en cours et il est correctement sélectionné. Pas de problème de ce coté là.
J'ai donc sélectionné un article et celui-ci à au moins une information manquante, voire les 2. C'est souvent le cas des pièces adaptables.
- la référence TextBoxRefAdaptable
- le prix TextBoxTTC€Adapable il faut noter ici que le prix affiché est Toutes Taxes Comprises.
J'ai déjà mis en place des msg box auxquelles on a un choix de réponse, dont l'une propose de Modifier la fiche pour la mettre à jour.
Je voudrais pouvoir basculer vers le formulaire ModifierHonda qui a déjà son bouton opérationnel pour faire l'inverse.
Je n'arrive pas à trouver le code pour que le formulaire s'affiche sur la bonne pièce.
Le champs de référence qui est TOUJOURS rempli est : New_Ref_Honda (champs obligatoire pour créer une fiche article) doit servir de "lien" pour se localiser sur la bonne fiche produit.
Dans le formulaire AjouterAuDevis, j'ai essayé donc de faire une fonction que j'ai appelée ModifRefOuPrix (tout en bas de la page VBA)
cette fonction est appelée à 2 endroits (ligne 167 et 229), d'où l'idée de faire une fonction.
J'ai les ai mise tout à gauche pour les retrouver facilement avec mes pauvres yeux de 66 ans d'âge.
Les msgbox s'affichent correctement lorsqu'on fait le choix d'une pièce adaptable via le bouton option Choix pièce adaptable et que soit la réf est manquante, soit le prix, soit les deux.
En prenant la pièce référence 14620 MC7 000, ligne 126 de la feuille, on a un article qui correspond à ces conditions.
ligne 167 et 229 du formulaire AjouterAuDevis
'// PROJET
'// le formulaire Modification Honda doit s'ouvrir sur la référence Honda d'origine
ModifRefOuPrixJ'ai presque honte de vous montrer mes tentatives de création de cette fonction... mais bon.
Private Function ModifRefOuPrix()
Sheets("Honda").Activate
Dim iSect As Range
Dim RefHonda As String
RefHonda = Me.TextBoxNewRefHonda.Text
' Dim LO: Set LO = Me.Range("Tableau1").ListObject
Dim LO: Set LO = Range("Tableau1").ListObject
' Set iSect = Intersect(Target, LO.DataBodyRange.Offset(, 4).Resize(, 10)) ' on a fait ce doubleclick dans une cellule des colonnes 4 à 10 (colonne M / 10-96Fr), du tableau. papicx 01/07/2025
' Set iSect = Intersect(RefHonda, LO.DataBodyRange.New_Ref_Honda) ' le nom du champs du Tableau1 papicx 05/09/2025
Set iSect = Application.IfError(Application.Match(RefHonda, LO.DataBodyRange.New_Ref_Honda)) ' le nom du champs du Tableau1 papicx 05/09/2025
If iSect Is Nothing Then Exit Function ' sinon = fin
Ligne_ModificationHonda = iSect.Row - LO.Range.Row ' N° du "listrow", donc dans le tableau, n'est pas la même chose que la ligne de la feuille
' If LO.DataBodyRange.Cells(Ligne_ModificationHonda, 7) <> "" Then ' désignation n'est pas vide, "variable public" du module1
If LO.DataBodyRange.Cells(Ligne_ModificationHonda, 3) <> "" Then ' New_Ref_Honda n'est pas vide, "variable public" du module1
M_ModifHonda Ligne_ModificationHonda
End If
End FunctionJe me suis inspiré du code existant sur la Feuille3 (Honda), tout en bas, et du code récemment reçu dans ce fil.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim iSect As Range
Dim LO: Set LO = Me.Range("Tableau1").ListObject
Set iSect = Intersect(Target, LO.DataBodyRange.Offset(, 4).Resize(, 10)) ' on a fait ce doubleclick dans une cellule des colonnes 4 à 10 (colonne M / 10-96Fr), du tableau. papicx 01/07/2025
If iSect Is Nothing Then Exit Sub ' sinon = fin
Ligne_ModificationHonda = iSect.Row - LO.Range.Row ' N° du "listrow", donc dans le tableau, n'est pas la même chose que la ligne de la feuille
If LO.DataBodyRange.Cells(Ligne_ModificationHonda, 7) <> "" Then ' désignation n'est pas vide, "variable public" du module1
M_ModifHonda Ligne_ModificationHonda
End If
End SubMerci de votre aide.
Salut Papicx,
Bon, encore une fois c'est vraiment difficile de suivre le projet, cependant si j'ai bien compris ton problème est que lorsque ModificationHonda s'affiche, il n'utilise pas la variable Ligne_ModificationHonda de ta fonction.
C'est normal pour 2 choses :
D'une part, pour que ton UserForm utilise cette variable lorsque tu l'affiches, il faut mettre a jour sa procédure Initialize pour qu'elle aille chercher cette ligne dans le tableau, et mette a jour ses textbox en fonction. Par exemple il faudrait lui ajouter le code ci-dessous :
Private Sub UserForm_Initialize()
Dim LO As ListObject
Set LO = Sheets("Honda").ListObjects("Tableau1")
If Ligne_ModificationHonda > 0 Then
With LO.DataBodyRange.Rows(Ligne_ModificationHonda)
TextBoxNewRefHonda.Text = .Cells(3).Value ' ici pour chaque textbox tu vas chercher la cell correspondante
TextBoxDesignation.Text = .Cells(7).Value ' le numero (3 ou 7 dans l'exemple) = numero de colonne
' etc.
End With
End If
' suite de ton code = celui deja present
End SubEnsuite, c'est le point essentiel, tu utilises Ligne_ModificationHonda dans ModifRefOuPrix, mais cette variable n'est définie nulle part, ainsi par défaut elle est supprimée dès que tu quittes ModifRefOuPrix. Pour corriger cela il faut la déclarer comme variable publique en haut d'un module/code d'UserForm.
Par exemple dans fonctions_perso ou dans ModificationHonda tu dois mettre en haut de module (sous "Option Explicit")
Public Ligne_ModificationHonda As StringEn espérant que cela fonctionne.