XL 2016 Vba créattion bouton macro lecture dans tableau multifactoriel

BARNS

XLDnaute Junior
Bonjour,

J'essaye de réaliser un outil qui permet de réaliser un inventaire en plusieurs étapes, l'idée est qu'a chaque étape l'utilisateur clique sur un bouton, une action se réalise en fonction de ses choix et un autre bouton apparaît pour pouvoir lancer l'étape suivante.

Etape 1 : Des listes déroulantes apparaissent en fonction du nombre de travée choisi, du type et de la présence de PAF
Etape 2: Une représentation des piquages des travées s'élabore en fonction des longueurs choisis


Par exemple si l'utilisateur choisi travée standard puis 62 en longueur, en se rapportant au tableau Cannes, cela correspond à 21 piquages

1623418229689.png



1623418323035.png


Etape 3 : Taille des tubes nécessaire en fonction des piquage ouvert (présence de 1), il obtient alors ses longueurs par piquage en fonction de sa config

Donc ici avec
– hauteur arroseur 3
– type de canne souple

Il a pour chaque piquage correspondants selon le tableaux cannes les longueurs (840, 1290 etc)

1623418751903.png


Etape 4 : Affichage des tubes par longueur

1623419057859.png

Etape 5 : Affichage du matériel total

La je suis bloqué à l'étape 2, je n'arrive pas à lire les valeurs de mon tableau page "cannes" pour savoir quel est le nombre de piquages max par longueur de travées.
Et du coup pouvoir enregistrer ces valeurs pour les réutiliser plus tard. Ci après mon code :


VB:
Function Piquages(TYPES, LONGR, PIQUAGE)

TYPES = .Cells(F, 7)
LONGR& "i" = .Cells(i & dernierecellule_colonne, 2)

'End With
With Sheets("Cannes")
   L1 = 0
    For L = 2 To .Range("A65500").End(xlUp).Row
        If .Cells(L, 1) = TYPES And .Cells(L, 2) = LONGR Then
            L1 = L
        End If
        If .Cells(L, 1) = TYPES And .Cells(L, 2) = LONGR And .Cells(L, 3) = PIQUAGE Then
        PIQUAGE = .Cells(L, 5)
        
        Else
            If .Cells(L, 1) = TYPES And .Cells(L, 2) = LONGR And .Cells(L, 3) > PIQUAGE Then
                Exit For
            End If
        End If
 MsgBox (PIQUAGE)
 Next L
 End With


 End Function

Merci pour votre aide!
 

Pièces jointes

  • CONFPARTAGE v3.xlsm
    58.1 KB · Affichages: 9
Dernière édition:

soan

XLDnaute Barbatruc
Inactif
Bonjour BARNS,

ton fichier en retour. :)

j'ai refait ta 1ère étape, puis j'ai fait ta 2ème étape ;
à toi de faire tous les tests nécessaires !

comme j'ai fait plein d'modifs partout (feuilles et code VBA),
regarde bien partout ! 😜 (feuilles et code VBA)

soan
 

Pièces jointes

  • CONFPARTAGE v3.xlsm
    66.1 KB · Affichages: 6

BARNS

XLDnaute Junior
Waouh...

Ok j'avais commencé à avancer entre temps mais bloqué à l'affichage des travées.

J'ai l'impression que tu as mis un peu d'ordre ;), il doit rester trois lignes de mon pauvre code...

Je vais assimiler ce que tu as fais avant de continuer merci beaucoup Soan!
 

soan

XLDnaute Barbatruc
Inactif
Bonjour BARNS,

j'ai trouvé un bug dans ma version précédente : sur la feuille "User", en B43, sélectionne 18 ; ensuite, la macro Piquages() plantera pour cette raison : sur la feuille "Cannes", dans le tableau "T_Cannes", toutes les lignes pour "PAF" sont avec une longueur de 30 ; comme la longueur 18 n'est pas trouvée, il n'y a pas de nombre de piquages maximum : mx reste à 0 ➯ plantage sur cette instruction : .AutoFill .Resize(, mx), 2

j'ai corrigé ce bug dans ma nouvelle version ; j'ai fait aussi cette petite optimisation : regarde cette instruction : .Resize(2, mx).Borders.LineStyle = 1 ; je l'ai remontée dans le With qui est juste au-dessus ➯ simplification : ça devient : .Borders.LineStyle = 1

j'ai fait beaucoup d'autres modifs dans mon code VBA précédent, et je l'ai aussi complété. :)



ouvre le fichier joint ci-dessous ; tout ce qui va suivre est sur la feuille "User".

IMPORTANT : note que j'ai supprimé le texte précédent de AA32 et AA33 car ça gênait le fonctionnement de la macro ! donc il ne faudra surtout pas y remettre quelque chose : ça doit rester vide !

regarde toutes les valeurs déjà présentes, puis clique sur le bouton "Étape 1" ➯ ça a ajouté en dessous 5 Travées + Paf ; les cases de Longueur sont vides, mais les listes déroulantes y sont ; fais ce qu'il faut pour arriver à ceci :

Image 1.jpg


c'est volontairement que j'ai laissé vides B23 et B38 ; clique sur le bouton "Étape 2" ➯ pour une Longueur choisie, ça a ajouté à droite le quadrillage adéquat ; pour les 2 cases de Longueur laissées vides, ça n'a rien fait du tout, et ça n'a pas planté. :) note que le bouton "Étape 2" est devenu "Étape 3" ; mais attention : ne clique pas dessus, car ce n'est pas le bon moment ! tu fausserais la démo en cours !

Image 2.jpg



pour la 2ème ligne d'un quadrillage, il n'y a que des 1 ; dans l'énoncé de ton post #1, à l'Etape 2, c'est bien comme ton quadrillage du haut ; mais pour ton quadrillage du bas, tu n'as pas expliqué comment ça arrive qu'il y a des cellules vides à la place de certains 1 ; j'ai supposé que c'est l'utilisateur qui efface lui-même, manuellement, quelques 1 ; c'est ce que tu vas faire maintenant, pour arriver à ceci :​

Image 3.jpg


clique maintenant sur le bouton "Étape 3", et admire le résultat :​

Image 4.jpg


ben voilà, la démo est finie ; il te reste plus qu'à étudier le code VBA ! 😁 😜



module M01_Effacer_TravéesPAF (61 lignes) :

VB:
Option Explicit

Dim lig&

Sub Effacer()
  If ActiveSheet.Name <> "User" Then Exit Sub
  Dim n&: n = Cells(Rows.Count, 1).End(3).Row
  On Error Resume Next: Application.ScreenUpdating = 0
  If n > 17 Then
    n = n + 2: Range("A18:Y" & n).Clear: Rows("18:" & n).RowHeight = 14.4
  End If
  ActiveSheet.Buttons("Étape 2").Delete
End Sub

Private Sub DoTravées()
  Dim i%
  For i = 1 To [F9] 'pour chacune des travées
    With Cells(lig, 1)
      .HorizontalAlignment = 4: .Value = "Travée " & i & " : "
      With .Offset(, 1)
        .HorizontalAlignment = 4: .IndentLevel = 1
        .Borders.Weight = xlMedium 'bordure contour
        With .Validation
          .Delete: .Add 3, , , "=" & [F7] 'liste déroulante Travée
        End With
      End With
    End With
    lig = lig + 5
  Next i
End Sub

Private Sub DoPAF()
  With Cells(lig, 1)
    .HorizontalAlignment = 4: .Value = "Paf : "
    With .Offset(, 1)
      .HorizontalAlignment = 4: .IndentLevel = 1
      .Borders.Weight = xlMedium 'bordure contour
      With .Validation
        .Delete: .Add 3, , , "=PAF" 'liste déroulante PAF
      End With
    End With
  End With
End Sub

Private Sub BtnÉtape2(b As Boolean)
  Dim G&, H&
  With Cells(lig + IIf(b, 4, -1), 1): G = .Left: H = .Top: End With
  With ActiveSheet.Buttons.Add(G, H, 62, 24)
    .Name = "Étape 2": .Caption = .Name: .OnAction = "Piquages"
  End With
End Sub

Sub TravéesPAF()
  If ActiveSheet.Name <> "User" Then Exit Sub
  Dim b As Boolean: lig = 18
  Call Effacer: Application.ScreenUpdating = 0
  Call DoTravées: b = UCase$(Trim$([F11])) = "OUI"
  If b Then DoPAF
  BtnÉtape2 b
End Sub



module M02_Piquages (48 lignes) :

VB:
Option Explicit

Sub Piquages()
  If ActiveSheet.Name <> "User" Then Exit Sub
  Dim TypTrv$: TypTrv = [F7]: If TypTrv = "" Then Exit Sub
  Dim n1&: n1 = Cells(Rows.Count, 2).End(3).Row: If n1 < 18 Then Exit Sub
  Dim n2&, vx$, mx As Byte, pg As Byte, L%, i&, j&
  TypTrv = UCase$(Replace$(Replace$([F7], "_", " "), "é", "e"))
  With Worksheets("Cannes")
    With .ListObjects("T_Cannes")
      If .DataBodyRange Is Nothing Then Exit Sub
      n2 = .ListRows.Count + 1: Application.ScreenUpdating = 0
    End With
    For i = 18 To n1 Step 5
      L = Val(Cells(i, 2))
      If L > 0 Then
        mx = 0
        For j = 2 To n2
          vx = .Cells(j, 1)
          If vx = TypTrv Or vx = "PAF" Then
            If .Cells(j, 2) = L Then
              pg = .Cells(j, 3): If pg > mx Then mx = pg
            End If
          End If
        Next j
        If mx > 0 Then
          With Cells(i, 4)
            .Value = 1: .AutoFill .Resize(, mx), 2
            .Offset(1).Resize(, mx) = 1
            With .Resize(2, mx)
              .HorizontalAlignment = 4: .IndentLevel = 1: .Borders.LineStyle = 1
            End With
            With .Offset(2)
              .EntireRow.RowHeight = 38
              With .Resize(, mx)
                .HorizontalAlignment = 3: .VerticalAlignment = 1: .Orientation = 90
              End With
            End With
          End With
        End If
      End If
    Next i
  End With
  With ActiveSheet.Buttons("Étape 2")
    .Caption = "Étape 3": .OnAction = "LongCannes"
  End With
End Sub



module M03_LongCannes (50 lignes) :

VB:
Option Explicit

Private Sub SetCol(TC$, HA$, k%)
  Select Case TC
    Case "Souple": k = 5 + (HA = "3")
    Case "Souple sous tirants": k = 7 + (HA = "3")
    Case "Souple double"
      k = 11 + (Right$(HA, 1) = "a") + 2 * (Left$(HA, 1) = "3")
    Case "PVC_Souple": k = 13
    Case "PVC": k = 12
  End Select
End Sub

Sub LongCannes()
  If ActiveSheet.Name <> "User" Then Exit Sub
  Dim TypTrv$: TypTrv = [F7]: If TypTrv = "" Then Exit Sub
  Dim TypCan$: TypCan = [N9]: If TypCan = "" Then Exit Sub
  Dim HtrArr$: HtrArr = [N7]
  If Left$(TypCan, 6) = "Souple" And HtrArr = "" Then Exit Sub
  Dim n1&: n1 = Cells(Rows.Count, 2).End(3).Row: If n1 < 18 Then Exit Sub
  TypTrv = UCase$(Replace$(Replace$([F7], "_", " "), "é", "e"))
  Dim k%: SetCol TypCan, HtrArr, k: If k = 0 Then Exit Sub
  Dim s$, m%, d%, n2&, vx$, pg As Byte, L%, i&, p&, j&: m = Columns.Count
  With Worksheets("Cannes")
    With .ListObjects("T_Cannes")
      If .DataBodyRange Is Nothing Then Exit Sub
      n2 = .ListRows.Count + 1: Application.ScreenUpdating = 0
    End With
    For i = 18 To n1 Step 5
      L = Val(Cells(i, 2))
      If L > 0 Then
        d = Cells(i, m).End(1).Column - 3: s = String$(d, "1"): p = i + 1
        For j = 1 To d
          If Cells(p, j + 3) <> 1 Then Mid$(s, j, 1) = "0"
        Next j
        p = p + 1
        For j = 2 To n2
          vx = .Cells(j, 1)
          If vx = TypTrv Or vx = "PAF" Then
            If .Cells(j, 2) = L Then
              pg = .Cells(j, 3)
              If Mid$(s, pg, 1) = "1" Then Cells(p, pg + 3) = .Cells(j, k) & "  "
            End If
          End If
        Next j
      End If
    Next i
  End With
End Sub



bon courage pour tout lire (et tout comprendre) ! 😁 😄 🍀

à te lire pour avoir ton avis. 😉

soan
 

Pièces jointes

  • CONFPARTAGE v4.xlsm
    70.4 KB · Affichages: 5

soan

XLDnaute Barbatruc
Inactif
@BARNS

Lis d'abord mon très long post #4 précédent. :)

j'ai vu l'explication des 1 qui deviennent des cellules vides sur ton autre sujet « Sélection dernière ligne, création de liste déroulante X fois, macro vba », post #7 : « Après l'utilisateur indique quels piquages sont fermés en supprimant les 1 » ; donc ce n'est pas un automatisme, c'est bien une intervention manuelle de l'utilisateur.​

soan
 
Dernière édition:

BARNS

XLDnaute Junior
Bon j'avoue c'est absolument magnifique ... Franchement merci beaucoup

Au moment ou je commençais a comprendre l'autre code ... 😓

Pour la petite histoire c'est 38 fichiers excel que je fusionne grâce à toi... Ca sera beaucoup plus simple quand il y aura une modif à faire..

J'ai bien avancé dessus et j'ai fait le ménage de printemps dans les données.

Même si je ne crois pas qu'on avance au même rythme.

Je continue a bosser je reviendrais vers toi peut être pour des questions spécifique mais il me reste pas mal de trucs à comprendre.

Je voulais surtout te répondre rapidement pour te remercier.

Bonne fin de semaine!
 

Pièces jointes

  • CONFPARTAGE v8.xlsm
    98 KB · Affichages: 3

BARNS

XLDnaute Junior
Bon j'avoue que j'ai un peu de lacune en VBA.

Je pense que je devrais créer un tableaux dynamique avec comme nombre de colonne le nombre de travée + le PAF et en ligne les données a réutiliser.
Notamment le nombre de piquage et leur type : PiqOuv, PiqSt, PiqTour, PiqRéh, PiqRampe, PiqKitrou pour pouvoir additionner tranquillement ensuite.

Mais le problème que je rencontre est que je n'arrive pas a m'insérer dans le code.

Comme je comprends pas trop le autofill.resize(,mx), 2, j'ai du mal a m'approprié la fonction.

J'ai tenté de commencer mon tableau en changeant la boucle for sur le module piquage pour que ca soit plus simple mais j'arrive pas à mettre la main sur le problème.

Après c'est sûr que la syntaxe suivante doit être mauvaise, puisque je suppose que .value = doit être égal à un chiffre.

VB:
 With Cells(i - 1, 4)    
      If i = 1 Then
          .Value = 1
          Else
          .Value = pg: .AutoFill .Resize(, mx), 2

Je continue de chercher. Mais si tu passes par là :)

Dans tout les cas merci!

Bon week end!
 

Pièces jointes

  • CONFPARTAGE v8.xlsm
    96.4 KB · Affichages: 1

soan

XLDnaute Barbatruc
Inactif
Bonjour BARNS,

Comme je comprends pas trop le Autofill.Resize(, mx), 2, j'ai du mal à m'approprier la fonction.

ça, c'était dans la sub Piquages() ; la partie concernée est celle-ci :​

VB:
With Cells(i, 4)
  .Value = 1: .AutoFill .Resize(, mx), 2
End With

c'est pour une ligne i donnée ; selon la boucle For i : 1ère valeur = 18.

a) Cells(i, 4).Value = 1 : idem que Cells(18, "D") = 1 : idem que [D18] = 1 ;
on a mis 1 en cellule D18 ; ce 1 va servir pour pouvoir faire le AutoFill.

b) Cells(i, 4).AutoFill .Resize(, mx), 2 : mx est le nombre de piquages maximum ; pour la Longueur de travée 62, c'est : 21 piquages ; 2 est la constante numérique de xlFillSeries ➯ l'instruction VBA revient à :

[D18].AutoFill .Resize(, 21), xlFillSeries : à partir de la cellule D18 et vers la droite, pour 21 colonnes en tout (donc y compris D18 ➯ jusqu'en X18), on va étendre la série qui commence avec le 1 de D18 ➯ bingo ! ça y'est, on a bien ce qu'on voulait : ce sont les nombres 1 à 21 de D18 à X18 (je les ai mis sur fond jaune clair pour que tu les voies mieux) :​

Image.jpg


soan
 

BARNS

XLDnaute Junior
Salut Soan,

Merci pour ton aide, le projet avance petit à petit et c'est un peu grâce a toi que ça avance!! Je pense que j'en serais encore au tout début sinon.

J'ai modifié les datas au niveau du PAF maintenant plus de problèmes ! :)

C'est merveilleux j'ai réussi à modifier ton code tout en m'aidant de la logique que tu as utilisé sur les différents modules.

sur MO2_Piquages
J'ai modifié la boucle :

VB:
 For i = 18 To n1 Step 5

Par

Code:
 For i = 1 To [F9] + 1

Comme tu avais fait sur MO1, comme ca je crée un tableaux qui regroupe le nombre de piquages par travées et je peux additionner le nombre piquages total.


Code:
pgmx =1

[...]

ReDim Preserve tabTrv(i)
              tabTrv(i) = pg
[...]

pgmx = tabTrv(i) + pgmx

Jusqu'ici tout va bien :) et c'est plutôt satisfaisant !

(Après quand je cherche à réutiliser mon tableau tabTrv() dans le MO3 pour pouvoir comptabiliser les piquages ca ne marche pas.)

Ca m'a "obligé à m'insérer dans ta boucle mais ca ne marche pas pour compter les piquages rehaussés même en ayant modifié la tab canne.

Mais pour ca je finirais par trouver une solution je pense.

J'ai juste deux questionnement :

Est ce que je peux extraire les données de la tab montage avec par exemple :
Si tête en haut avec régulateur alors j'affiche à la suite

Mamelon MM acier 20/27 3/4" ---PJ28015 - 1*PiqSt
Coude galva 90° -------------------PJ00115- 1*PiqSt
réhausse tube 3/4" LG450 GALVA-DG0067- 1*PiqTour

Ou alors je dois ordonner mes données d'une autre manière ?

Est-ce que je peux additionner les doublons des cannes qui sorte en ligne( 20+i5) avec i nombre de travées
et avoir :
3 de 2070
2 de 2310
1 de 2745 par exemple
?

En tout cas merci beaucoup pour m'avoir aidé jusqu'ici, j'essaye de fouiller le plus possible sur internet avant de demander de l'aide mais j'ai l'impression que par moment il y a des fonctions vba qui font des choses directement et on ne peut pas trop les inventer...

Je te laisse regarder comment j'ai avancé si ca t'intéresse!

petite question bonus si tu as le temps :
pour quoi je ne peux pas écrire ?
Code:
If TypCan = "tête_en_haut" Then ...
et je suis obligé de mettre
Code:
 If [N9] = "tête_en_haut" Then ...
alors que tu as bien déclaré
Code:
 Dim TypCan$: TypCan = [N9] ...
 

Pièces jointes

  • CONFPARTAGE v9.xlsm
    121.1 KB · Affichages: 2
Dernière édition:

soan

XLDnaute Barbatruc
Inactif
Bonjour BARNS,

j'ai regardé ton fichier "CONFPARTAGE v9" ; désolé, mais ça ne me dit rien de continuer à partir de ce fichier ! j'ai donc continué à partir de l'ancien fichier "CONFPARTAGE v4", où j'ai poursuivi un peu pour arriver à cette étape que tu connais déjà, puisqu'on y était arrivé la dernière fois :​

Image 1.jpg


rappel : c'était la dernière image de mon très long post #4 (elle était juste avant le code VBA placé entre des balises de code).



ouvre le fichier v5 joint en fin de ce post ; note que j'ai ajouté une feuille "Tubes", qui est entièrement vide ; va sur la 1ère feuille "User", où tu peux voir ce qu'il y a sur l'image que je viens de te montrer plus haut (au-dessus du long trait) ; fais Ctrl e ➯ travail effectué ! 😊

Image 2.jpg


c'est donc l'Étape 4 de ton exo, pour toutes les travées + un éventuel PAF.​



code VBA du module M04_Tubes (46 lignes) :

VB:
Option Explicit

Sub Tubes()
  If ActiveSheet.Name <> "User" Then Exit Sub
  Dim n1&: n1 = Cells(Rows.Count, 2).End(3).Row: If n1 < 18 Then Exit Sub
  Dim m%, d%, n2%, vx%, L%, i&, p&, j&, r&, t&, k%, b As Byte
  m = Columns.Count: Application.ScreenUpdating = 0
  With Worksheets("Tubes")
    With .Columns
      .ClearContents: .Interior.ColorIndex = -4142
      .Borders.LineStyle = -4142: .ColumnWidth = 7
    End With
    .Columns(1).ColumnWidth = 5: k = 3
    For i = 18 To n1 Step 5
      L = Val(Cells(i, 2))
      If L > 0 Then
        d = Cells(i, m).End(1).Column - 3: p = i + 2: n2 = 0: r = 1
        For j = 1 To d
          vx = Cells(p, j + 3)
          If vx > 0 Then
            b = 0
            If n2 > 0 Then
              For t = 1 To n2
                With .Cells(t + 1, k - 1)
                  If .Offset(, 1) = vx Then .Value = .Value + 1: b = 1: Exit For
                End With
              Next t
            End If
            If b = 0 Then
              r = r + 1: .Cells(r, k) = vx: .Cells(r, k - 1) = 1: n2 = n2 + 1
            End If
          End If
        Next j
        With .Cells(2, k - 1)
          .EntireColumn.ColumnWidth = 5: .Offset(, 2).EntireColumn.ColumnWidth = 6
          With .Resize(n2, 2)
            .Borders.LineStyle = 1: .Interior.Color = 14211288
          End With
          .Interior.ColorIndex = -4142: k = k + 3
        End With
      End If
    Next i
    .Select
  End With
End Sub



dans la sub LongCannes() de ton fichier v9, il y a cette ligne :​

VB:
If ActiveSheet.Name <> "User" Then Exit Sub 'si la feuille active est différente de user alors ne pas réalisé le code ?

c'est exact : on sort de la sub si la feuille active n'est pas "User" ; donc pour tout le code VBA qui est placé en dessous, il sera exécuté seulement si la feuille active est "User" ; et toute référence de cellule qui est sans mention explicite de feuille est une cellule de la feuille active, donc de la feuille "User".​



au même endroit, un peu plus bas, il y a aussi cette ligne :

VB:
If Left$(TypCan, 6) = "Souple" And HtrArr = "" Then Exit Sub 'si typcan = quelque chose mais hauteur arroseur rien alors partir ?

c'est plutôt : TypCan est le type de canne ; si les 6 premiers caractères de gauche de TypCan = "Souple" et qu'il n'y a pas de hauteur d'arroseur, alors on sort de la sub ; en effet, pour tous les types de cannes qui commencent par "Souple", il faut obligatoirement que l'utilisateur ait saisi une hauteur d'arroseur, car ensuite il faudra une correspondance avec la feuille "Cannes", cellules D1:K1 (selon mon fichier v4 ; car selon ton fichier v9, tu as ajouté toute une série "Souple_Galva" en L1:S1) ; note aussi que les seuls types qui ne commencent pas par "Souple" sont les 2 types "PVC" et "PVC+SOUPLE" (j'ai vu que pour le 2ème, tu as remplacé le signe « + » par un souligné « _ ») ; pour les 2 types PVC, j'avais bien vu qu'une hauteur d'arroseur n'est pas nécessaire ! c'est pour cela que mon test de hauteur d'arroseur est uniquement pour les cannes de type "Souple".​



pour ta question bonus, je n'ai pas de réponse, car en principe, ça aurait dû marcher, de mettre TypCan et pas [N9] ; peut-être as-tu fait une fausse manip ? j'aurais pu t'aider davantage là-dessus si tu avais mieux précisé ce qui n'a pas marché au juste, au lieu de mettre simplement : « pourquoi je ne peux pas écrire ? » ; si, tu peux écrire en VBA tout c'que tu veux (du moins en théorie), mais c'est pas garanti qu'ça va marcher ! 😁 (c'était une réponse dans le style : « oui, il peut le faire ! 😇 ») ; mébon, sérieusement : s'il y a eu un message d'erreur, quel en était le texte exact ? et si ça a planté sur une ligne de code VBA, quelle était la ligne jaune mise en évidence ? ou quel mauvais résultat ça a donné à l'exécution de la macro ? au lieu de quel bon résultat ?

pour ta 2ème question, si j'ai bien compris, c'est ce que j'ai déjà fait dans mon fichier joint, sub Tubes(), afin de noter le bon nombre total pour chaque type de cannes : on additionne les nombres pour aboutir à la 2ème image de ce post (celle qui est juste avant le code VBA placé entre des balises de code).

pour ta 1ère question à propos d'extraire les données de la tab montage, j'ai une idée qui devrait marcher sans que tu doives ordonner tes données d'une autre manière ; mais comme je fatigue, ce sera pour une autre fois ! donc la suite au prochain épisode ! 😜

soan
 

Pièces jointes

  • CONFPARTAGE v5.xlsm
    76.6 KB · Affichages: 2

soan

XLDnaute Barbatruc
Inactif
@BARNS

le fichier v6 joint est mon fichier v5, que j'ai complété pour faire ta demande d'extraction. :)

note que la feuille "Extract" est vide ; va sur la feuille "Montage", et fais Ctrl f ➯ ceci :​

Image.jpg


note que pour le signe de la multiplication (le "nombre de fois" si tu préfères), au lieu d'une étoile « * », j'ai mis volontairement le signe mathématique "multiplier" : « × » ; tu peux le "créer" ainsi : appuie sur la touche Alt gauche, et maintiens-la enfoncée ; sur le pavé numérique, tape le code 0215 ; relâche la touche Alt ; au cas où tu préférerais quand même le signe « * », il te suffit de remplacer « × » par « * » dans la ligne de code VBA concernée : T2(j, 3) = rg & "×" & T1(i, 1): j = j + 1 ; le code VBA complet de la sub Extraction() est ci-dessous.​



code VBA du module M05_Extraction :

VB:
Option Explicit: Option Base 1

Sub Extraction()
  If ActiveSheet.Name <> "Montage" Then Exit Sub
  Dim n&: n = Cells(Rows.Count, 5).End(3).Row: If n < 3 Then Exit Sub
  Dim T1, T2, rg As Byte, i&, j&
  T1 = Range("B3:E" & n): n = n - 2: ReDim T2(n, 3): j = 1
  For i = 1 To n
    rg = T1(i, 4)
    If rg > 0 Then
      T2(j, 1) = T1(i, 2): T2(j, 2) = T1(i, 3)
      T2(j, 3) = rg & "×" & T1(i, 1): j = j + 1
    End If
  Next i
  Application.ScreenUpdating = 0
  With Worksheets("Extract")
    .Columns("B:D").ClearContents: .[B2].Resize(j - 1, 3) = T2
    .Select
  End With
End Sub



remarque : tout c'que j'avais fait avant pour la sub Tubes() est aussi dans ce fichier. ;)

soan
 

Pièces jointes

  • CONFPARTAGE v6.xlsm
    88.5 KB · Affichages: 3
Dernière édition:

BARNS

XLDnaute Junior
Bonjour SOAN,

J'espère que tu vas bien!

Bon avant toute chose un grand merci pour ton aide continu.

Comme tu ne voulais pas continuer sur mon fichier, je me suis dit pourquoi? Et finalement l'hypothèse c'est qu'il était probablement mal structuré et c'est vrai que ca ne donne pas envie. J'ai donc cherché à améliorer l'organisation du code. Aussi j'avais commencé un tri au niveau des données pour qu'elles soient plus facilement exploitables. Entre temps tu m'as envoyé ton message.

J'ai donc voulu repartir du bon pied pour que la base de donnée soit facilement modifiable et pour que le code soit facilement compréhensible.

Voici les modifications :

Dans la base de données :
– Sur l'ensemble des Tabs les références ont été rajoutées
– Tab "Cannes" nom des colonnes équivalentes au choix user cf Datas!M21
– Tab "Cannes" colonne tête en haut rajouté
– Tab "Montage" nom des colonnes équivalentes au choix user cf Datas!R21
– Tab "Datas" un tableau pour les cannes avec une colonne appellation pour les combinaisons de choix
– Tab "Datas" un tableau pour les montages avec une appellation pour les combinaisons de choix

Dans le code :
Un module dédié M00_Variables pour
– les choix utilisateurs qui seront a réutiliser tout le long du code. Si les emplacement des liste change les modifications seront simples
– les variables Piquages qui définiront a plusieurs endroit la liste matériel
– la structure de la machine sous forme de tableau avec le nombre de ligne équivalent au nombre de travées et pour chacune le nombre de piquages et donc de cellules.
– M02: Une partie de code pour comptabiliser et afficher le nombre de piquages total.
– M03: une parti pour définir K même si avec "choixmont" ca devrait être facile de chercher dans cannes!
– M03: une partie pour définir le nombre de piquages standart, piquage rampe, piquage réhaussé etc afin de pouvoir le multiplier par le matériel.
– M05: un module pour la création du matériel
– M10: pour l'impression pdf et l'enregistrement
– MAIN: un module principale qui lance les différents modules à la suite

Ce que j'ai du mal à faire :

1– Une formule pour additionner les doublons pour le M05 et le M04
2– Réussir les déclaration de variables pour pouvoir les utiliser entre les différents modules et minimiser le nombre de déclarations.
3– Simplifier les partis de codes en utilisant ces variables


Je crois que j'ai manqué de beaucoup de précision dans mes questions auparavant. Pour clarifié le résultat souhaité j'ai réalisé un fichier avec un résultat potentiel "CONFPARTAGE_pres"

Le fichier sur lequel j'ai fait avancé le code est "CONFPARTAGE v14"

Il fallait absolument que je te fasse un retour pour te remercier, je sens que j'arrive sur la fin je ne pense pas rencontrer de problème pour afficher les buses et le matériels mais si tu as un moment pour mes trois petis points ca serait merveilleux.

Voilà de toute façon je continu de travailler de mon côté, je vais bien finir par le terminer ce fichier...

Merci!
 

Pièces jointes

  • CONFPARTAGE v14.xlsm
    145.1 KB · Affichages: 2
  • CONFPARTAGE_pres.xlsm
    134.3 KB · Affichages: 4

BARNS

XLDnaute Junior
Modification supplémentaire:
Pour permettre des modifications d'emplacement de cellules

Dans la base de donnée:
– Attribution des noms au différentes cellule qui ont des listes
Dans le code :
– Changement des références explicites en nom de plages

PB
 

Pièces jointes

  • CONFPARTAGE v16.xlsm
    144.8 KB · Affichages: 1

BARNS

XLDnaute Junior
Bonjour Soan,

Toujours bloqué sur la partie doublon MO4_Tubes, mais le reste du code avances.

Modifications supp:

Dans la base de donnée :
– Tab datas et User : choix sous condition, suppression des choix multiples incompatibles

Dans le code :
M06, M07, M08 : création
– M04 : tentative de modification du code

Une fois encore merci pour tout les bases de code que tu m'as donné m'aide beaucoup, si tu passe par la et que tu as une idée pour la partie tube ca serait top sinon bon journée!
 

Pièces jointes

  • CONFPARTAGE v19.xlsm
    168.4 KB · Affichages: 5

Discussions similaires

Statistiques des forums

Discussions
311 715
Messages
2 081 822
Membres
101 821
dernier inscrit
hybroxis