Userform sous détail

[abtony]

bonsoir le forum,

est t'il possible de simplifié ce code ?

de plus j'ai une erreur sur le code présent et ca me plante excel.

pouvez vous m'aider

merci a vous

 

[skoobi]

Re : Userform sous détail

Bonjour,

Tu ne mets aucune explication dans le fichier.
Tu ne risque pas d'avoir de réponse à moins que quelqun à 1/2 heure de temps pour déjà comprendre de quoi il en retourne pour le code.....

 

[abtony]

Re : Userform sous détail

Bonjour Skoobi et le forum,

oui c'est vrai, je suis pas assez explicite, je m'en excuse.

Voila sur cet userform, j'ai un combo sur lequel je sélectionne des articles, qui viennent se ranger dans les textbox juste en dessous, je met ma quantité et je valide pour que ca viennent en complément de mon sous détail (Bouton valider pas encore crée pour cette action), qui lui compose un ouvrage avec son numéro 01010101011 par exemple.

Une fois le sous détail complet je l'archive en feuille SDBDD sur une seule ligne.

j'ai un autre combo en bas de l'userform, qui lui appelle un sous détails existant pour faire une mise a jour du prix article, et remettre a jour la feuille SDBDD.

Pour l'archivage je suis obligé de stocké les articles en feuille Sous_Détails et les copier vers la feuille SDBDD.

Mon soucis c'est que je trouve mon code un peu barbare et long, donc je solicite votre aide pour le simplifié, car la j'ai un peu de mal !!! ca viendra un jour j'y arriverait avec toutes les infos qu'on trouve sur le forum et votre aide.

En plus quand je modifie un sous détail déja archivé, la première fois ca va mais la deuxième plantage complet d'excel !!!!!

voila un peu pour résumé la chose !

Merci encore a vous tous.

"Je suis métreur et je travaille a domicile"

et je cherche a me faire des outils de travail pour facilité ma tache, mes compéténces en excel sont encore loin des votres ! mais ca viendra 🙂

Cordialement

 

[abtony]

Re : Userform sous détail

Bonsoir le forum,

quelqu'un peut il m'aider svp

Merci a vous

 

[Roland_M]

Re : Userform sous détail

bonsoir abtony, j'ai regarder un peu ton classeur
l'userform est pas mal fait, mais la programmation est toute à revoir !
beaucoup trop de travail ! beaucoup trop de lignes répétitives inutiles en contradiction !?
personne ne va passer une journée pour modifier tout ça, malheureusement !

Un forum peu t'aider sur une fonction, une macro, voir même toute une partie de code,
mais pas refaire tout un classeur aussi avançé et excuse moi(un peu fouilli)
on ne s'y retrouve plus ! beaucoup trop compliqué !

Bon courage. Roland.

 

[jeanpierre]

Re : Userform sous détail

Bonsoir le fil, Roland,

Dans l'esprit, Roland, total avec toi.... même si............

On va dire aussi, bon courage.. et bonne soirée, ou bonne nuit déjà avancée.

Jean-Pierre

 

[abtony]

Re : Userform sous détail

Bonsoir Roland_M,

tout d'abord je te remercie pour ta réponse ! c'est clair net et précis.

C'est pour ca que sur ma demande plus haut, je précise que mon code est un peu barbare.

Je ne demande pas que l'on fasse mon travail, ce n'est pas le but du forum tu a tout a fait raison la dessus !

Je demande simplement de l'aide et des conseils pour simplifié ce code, comme sait si bien le faire skoobi que je remercie sincèrement au passage.

Je suis la pour apprendre, et évolué avec votre aide et vos conseils si vous le voulez bien !

Comme vous avez tous pu voir je touche un peu a vba, mais je suis loin mais très loin des compétences des personnes qui composent ce forum.

Sur ce je vous souhaite une très bonne nuit

Tony

 

[skoobi]

Re : Userform sous détail

Re bonjour tout le monde,

Je demande simplement de l'aide et des conseils pour simplifié ce code, comme sait si bien le faire skoobi que je remercie sincèrement au passage.

Ca c'est pour me motiver à regarder ton fichier non..😛
Nan, je plaisante, merci du compliment, ça fait toujours plaisir.

J'ai mis en commentaire les codes que tu as créé pour les 2 combo et créés au-dessus mon code, tu pourras comparer.
Une remarque: cela permettra d'éviter les ".Select" qui ne servent à rien en VBA (ralentie le code quand il y a beaucoup de données).
Ca me rappelle mes débuts en VBA..... 😉
Pas évidant de faire une boucle pour le combo sous détail car les cellules ne se suivent pas....
Par contre, il y aura surement quelque chose à faire pour le code du bouton "valider", inspire toi de ceux que j'ai fais, le principe reste le même.

En plus quand je modifie un sous détail déja archivé, la première fois ca va mais la deuxième plantage complet d'excel !!!!!

J'ai pas eu le temps de creuser la chose pour l'instant.

 

[Roland_M]

Re : Userform sous détail

bonjour à tous
excuse moi abtony si je t'ai froissé, ce n'était pas du tout le but
j'ai cette sale manie d'être direct, qui peut paraître intolérant, on me l'a déjà fait remarqué, mais je ne suis pas comme ça.
skoobi a été plus sympa et j'espère que c'est un début pour toi
continue à progresser et n'hésites pas à poser des questions.
encore bon courage, toute mes amitiés et bon week-end à tous.
CORDIALEMENT Roland

 

[abtony]

Re : Userform sous détail

bonjour à tous
excuse moi abtony si je t'ai froissé, ce n'était pas du tout le but
j'ai cette sale manie d'être direct, qui peut paraître intolérant, on me l'a déjà fait remarqué, mais je ne suis pas comme ça.
skoobi a été plus sympa et j'espère que c'est un début pour toi
continue à progresser et n'hésites pas à poser des questions.
encore bon courage, toute mes amitiés et bon week-end à tous.
CORDIALEMENT Roland

Bonjour skoobi, roland_m,

roland_m, tu ne ma pas du tout froissé loin de la, tu ma motivé d'avantage dans ma recherche personnelle.

D'ailleurs je viens de trouver ce matin même la solution a mon problème, sur des sources que j'avais il y a déjà quelques années.

Ca simplifie mon code barbare en quelques lignes de commandes pour archivés et modifié éventuellement une donnée dans l'archive comme sur mon fichier exemple, ce code n'est pas de moi mais il fonctionne très bien.

Dés que j'aurais fait mes modifications je joint le fichier, si vous avez le temps dites moi simplement ce que vous en pensez, ca aide a évoluer ! et a comprendre.

skoobi, un remerciement très particulier pour toi car tu est quasiment toujours le seul a répondre a mes demandes.

je vais analyser ton code et comparer a celui que j'ai trouver ce matin et je vous dis quoi.

Je vous souhaite un agréable week end a tous et de préférence avec le soleil !

Amicalement

 

[abtony]

Re : Userform sous détail

re,

skoobi, j'ai analysé ton code et comme tu a pu le voir dans la feuille sous détails de prix, il y a 45 cellules au maxi qui doivent être archivée.

donc ton code qui est déja beaucoup mieux que le mien, mais encore long.

voici le code qui permet d'archivée l'ensemble des cellules sur une seule ligne.

il est pas adapté encore a ma feuille, mais je vais le faire demain matin.

Dim TBf As Worksheet, TBa As Worksheet, ZZ As Range, Erg, i As Integer
Set TBa = ThisWorkbook.Worksheets("Archive")
Set TBf = ThisWorkbook.Worksheets("Formulaire")
If IsEmpty(TBf.[no_facture]) Then   'Si absence de numéro de facture
  MsgBox (MSGNONR)
  Exit Sub
End If
Set ZZ = TBa.Columns(1).Find(what:=TBf.[no_facture].Value)
If ZZ Is Nothing Then
  Set ZZ = TBa.Cells(16384, 1).End(xlUp).Offset(1, 0)   'Ligne pour nouvelle entrée
Else
  If Not MsgBox(MSGNREXIST, vbQuestion + vbYesNo) = vbYes Then Exit Sub 'Ne pas remplacer l'entrée existante
End If
'Copie de toutes les données de la facture
Application.ScreenUpdating = False
For i = 0 To 3 Step 1
  ZZ.Offset(0, i).Value = TBf.[no_facture].Offset(i, 0).Value  'Copie identification de la facture
Next i
For i = 0 To 5 Step 1
  ZZ.Offset(0, i + 4).Value = TBf.Cells(6, 3).Offset(i, 0).Value 'Copier l'adresse
Next i
For i = 0 To 14 Step 1
  ZZ.Offset(0, i + 10).Value = TBf.Cells(21, 1).Offset(i, 0).Value 'Copier les références
Next i
For i = 0 To 14 Step 1
  ZZ.Offset(0, i + 25).Value = TBf.Cells(21, 2).Offset(i, 0).Value 'Copier les articles
Next i
For i = 0 To 14 Step 1
  ZZ.Offset(0, i + 40).Value = TBf.Cells(21, 3).Offset(i, 0).Value 'Copier la quantité
Next i
For i = 0 To 14 Step 1
  ZZ.Offset(0, i + 55).Value = TBf.Cells(21, 4).Offset(i, 0).Value 'Copier les prix unitaires
Next i
For i = 0 To 14 Step 1
  ZZ.Offset(0, i + 70).Value = TBf.Cells(21, 5).Offset(i, 0).Value 'Copier les codes de TVA
Next i
Application.ScreenUpdating = True

celui-ci permet d'archiver sur 15 lignes et 5 colonnes

idem pour la récupération de donnée.

Comme je l'ai dis plus haut après modification je joint mon fichier ca servira a d'autres newbies, ce classeur va me permettre de crée pas loin de 30 000 sous détails d'ouvrages bâtiment.

Donc encore unn peux le fouillis 😀

Bonne journée et merci

 

[chris]

Re : Userform sous détail

Bonjour

On peut simplifier la partie
For i = 0 To 14 Step 1
ZZ.Offset(0, i + 10).Value = TBf.Cells(21, 1).Offset(i, 0).Value 'Copier les références
Next i
For i = 0 To 14 Step 1
ZZ.Offset(0, i + 25).Value = TBf.Cells(21, 2).Offset(i, 0).Value 'Copier les articles
Next i
For i = 0 To 14 Step 1
ZZ.Offset(0, i + 40).Value = TBf.Cells(21, 3).Offset(i, 0).Value 'Copier la quantité
Next i
For i = 0 To 14 Step 1
ZZ.Offset(0, i + 55).Value = TBf.Cells(21, 4).Offset(i, 0).Value 'Copier les prix unitaires
Next i
For i = 0 To 14 Step 1
ZZ.Offset(0, i + 70).Value = TBf.Cells(21, 5).Offset(i, 0).Value 'Copier les codes de TVA
Next i

En imbriquant 2 boucles
x=10
For j =1 to 5
For i = 0 To 14 Step 1
ZZ.Offset(0, i + x).Value = TBf.Cells(21, j).Offset(i, 0).Value 'Copier les références
Next i
x = x+15
Next j

 

[Roland_M]

Re : Userform sous détail

bonjour, petit bout de code concernant le Sub CommandButton1_Click()
à étudier !? ci c'est bien ce que tu souhaites !?

Private Sub CommandButton1_Click()
' VbLf remplace Chr(13)
' exp: variable ReponseMsgbox As Variant < peut être = True ou False (Vrai ou Faux idéal pour les tests)
' MsgBox permet comme ceci d'avoir la réponse !!!! mettre entre MsgBox avec les (   )
' ReponseMsgbox = MsgBox(M$, vbYesNo & vbInformation, "Information !")
Dim ReponseMsgbox As Variant, ExisteEtRemplacer As Variant
Application.ScreenUpdating = False
Sheets("SD_BDD").Activate: Range("a2").Select
ExisteEtRemplacer = False
Do Until ActiveCell.Value = ""
   If ActiveCell.Value = SousDet.CBsousdet Then
      M$ = "Cet Ouvrage existe Déjà !" & vbLf & "Voulez-vous Remplacer ?"
      ReponseMsgbox = MsgBox(M$, vbYesNo & vbInformation, "Information !")
      If ReponseMsgbox <> vbYes Then Exit Sub ' quitter
      ExisteEtRemplacer = True ' ok pour la suite
   End If
   ActiveCell.Offset(1, 0).Select
Loop
If ExisteEtRemplacer = False Then
   M$ = "Cet Ouvrage ne figure pas au Sous détails !" & vbLf & "Voulez-vous Ajouter au sous détails ?"
   ReponseMsgbox = MsgBox(M$, vbYesNo + vbQuestion, "Information !")
   If ReponseMsgbox <> vbYes Then Exit Sub ' quitter
End If
' suite modif
F$ = "sous_détails"
ActiveCell.Value = CD
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = DS
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = UNIT
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = TM
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("a9").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("b9").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("c9").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("d9").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("a10").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("b10").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("c10").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("d10").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("a11").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("b11").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("c11").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("d11").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("a12").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("b12").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("c12").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("d12").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("a13").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("b13").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("c13").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("d13").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("a14").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("b14").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("c14").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("d14").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("a15").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("b15").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("c15").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("d15").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("a16").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("b16").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("c16").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("d16").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("a17").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("b17").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("c17").Value
ActiveCell.Offset(0, 1).Select: ActiveCell.Value = Sheets(F$).Range("d17").Value
ActiveCell.Offset(1, 0).Select
Range("Designation").Clear
Range("code").Clear
Range("Unite").Clear
Range("Tpm").Clear
Range("SousDet").Clear

UserForm_Initialize
End Sub

Roland

 

[abtony]

Re : Userform sous détail

Bonjour chris,

En voila une très bonne chose 😉

ca avance, le code se retrouve vraiment très simplifié et performant.

je présume que pour la récupération de donnée ci joint ca dois être la même chose ?

Dim TBf As Worksheet, TBa As Worksheet, ZZ As Range, Erg, i As Integer
Dim Dlg As DialogSheet
Set Dlg = ThisWorkbook.DialogSheets("DlgArchive")
Set TBa = ThisWorkbook.Worksheets("Archive")
Set TBf = ThisWorkbook.Worksheets("Formulaire")
i = 2
With Dlg.[LFNr]
  .RemoveAllItems
  Do While Not IsEmpty(TBa.Cells(i, 1))   'Lecture des numéros de facture
    .AddItem Text:=TBa.Cells(i, 1).Value
    i = i + 1
  Loop
  If .ListCount > 0 Then .ListIndex = 1
  If Not Dlg.Show Then Exit Sub   'Affichage de la boîte de dialogue
  Set ZZ = TBa.Cells(.ListIndex + 1, 1)   'Affectation de la cellule sélectionnée
End With
'Récupération des données depuis l'archive :
Application.ScreenUpdating = False
For i = 0 To 3 Step 1
  TBf.[no_facture].Offset(i, 0).Value = ZZ.Offset(0, i).Value
Next i
For i = 0 To 5 Step 1
  TBf.Cells(1, 3).Offset(i, 0).Value = ZZ.Offset(0, i + 4).Value 'Adresse
Next i
For i = 0 To 14 Step 1
  TBf.Cells(16, 1).Offset(i, 0).Value = ZZ.Offset(0, i + 10).Value 'Références
Next i
For i = 0 To 14 Step 1
  TBf.Cells(16, 2).Offset(i, 0).Value = ZZ.Offset(0, i + 25).Value 'Articles
Next i
For i = 0 To 14 Step 1
  TBf.Cells(16, 3).Offset(i, 0).Value = ZZ.Offset(0, i + 40).Value 'Quantité
Next i
For i = 0 To 14 Step 1
  TBf.Cells(16, 4).Offset(i, 0).Value = ZZ.Offset(0, i + 55).Value 'Prix unitaires
Next i
For i = 0 To 14 Step 1
  TBf.Cells(16, 5).Offset(i, 0).Value = ZZ.Offset(0, i + 70).Value 'Prix unitaires
Next i
Application.ScreenUpdating = True

merci a toi chris

 

[chris]

Re : Userform sous détail

Re

Oui idem pour la partie
For i = 0 To 14 Step 1
TBf.Cells(16, 1).Offset(i, 0).Value = ZZ.Offset(0, i + 10).Value 'Références
Next i
For i = 0 To 14 Step 1
TBf.Cells(16, 2).Offset(i, 0).Value = ZZ.Offset(0, i + 25).Value 'Articles
Next i
For i = 0 To 14 Step 1
TBf.Cells(16, 3).Offset(i, 0).Value = ZZ.Offset(0, i + 40).Value 'Quantité
Next i
For i = 0 To 14 Step 1
TBf.Cells(16, 4).Offset(i, 0).Value = ZZ.Offset(0, i + 55).Value 'Prix unitaires
Next i
For i = 0 To 14 Step 1
TBf.Cells(16, 5).Offset(i, 0).Value = ZZ.Offset(0, i + 70).Value 'Prix unitaires
Next i