Probleme Pour Copier Une Listebox Dans Une Feuille De Mon Classeur + Autres Problemes

[GCFRG]

Bonsoir à tous, décidement, je ne peux me passer de vous.
J'ai des problèmes l'ors de la récupération d'une listbox dans mon classeur.

Je donnes toutes les explications "du moins je le penses " dans le USF de mon fichier joint.

Je galère depuis ce matin là dessus et je ne vois pas comment m'en sortir sans votre aide.

Alors un immense merci à celle ou celui qui pourra m'aider, et surtout n'hésiter pas à émettre des critiques sur ma manière de procéder des lors que ces dernières sont constructives c'est tous bénef pour mon apprentissage du VBA

voilà voilà
Gilbert

 

[Bebere]

Re : Probleme Pour Copier Une Listebox Dans Une Feuille De Mon Classeur + Autres Prob

bonsoir GCFRG,Hasco
en vitesse je pars en we
chez moi pas d'erreur
bouton supprimer ligne
Dim LstItem As Object'changer listitem
Hasco pour faire plus simple comme tu le dis si bien
une idée stocker dans tag l'index de la ligne si ligne-1=cbétage

à bientôt

 

[GCFRG]

Re : Probleme Pour Copier Une Listebox Dans Une Feuille De Mon Classeur + Autres Prob

Merci beaéucoup et bon WE à toi

Gilbert

 

[Guest]

Re : Probleme Pour Copier Une Listebox Dans Une Feuille De Mon Classeur + Autres Prob

Bonjour Bebere (bon WE?)
Bonjour GC,

Voici ton fichier modifié.
Une colonne cachée (largeur 0) à été ajoutée à la ListView, colonne qui contient un clef de tri pour situation/Pièce qui est construite ainsi:
"Elem" + 2 chiffres pour la situation qui correspondent au choix du ComboBox idoine + 2 autres chiffres pour la pièce qui correspondent au choix du Combo idoine également.

A partir de cette clef la listview est donc triée en fonction de la situation et de la pièce.

Lors de l'enregistrement dans la feuille de calculs la situation n'est enregistre qu'un fois à chaque changement et la pièce également.

S'i y a des choses à modifier. Joint la partie de programme désirée car le fichier même zippé fait plus que la taille maximale.

Je n'ai toujours pas compris à quoi servait la procédure Elimine(Ligne).

A bientôt

 

[GCFRG]

Re : Probleme Pour Copier Une Listebox Dans Une Feuille De Mon Classeur + Autres Prob

salut hasco, merci beaucoup pour ton coup de main.
je regarderais plus tard, il faut que je file, je donne des cours d'initiation à l'informatique pour des personnes du 3ème age dans une asso, a 14H et ils n'aiment pas attendre, et je me connais, si je commence à regarder maintenant, ils risquent de patienter un moment, je suppose que tu vois de quoi je parle, quand on est passionné............


je regarde çà vers 16h30
bon après midi

et merci encore, Gilbert

 

[GCFRG]

Re : Probleme Pour Copier Une Listebox Dans Une Feuille De Mon Classeur + Autres Prob

Salut le forum, bebere hasco
salut hasco, pas eu le temps de regardé avant aujourd'hui j'ai teste ça marche au poil pour les fenêtres mais pas quand j'ajoute 1 volet roulant(fenêtre + volet) je valide et rien, quand je selectionne volet roulant seul, ça bloque ici
ListView1.ListItems(1).Selected = False
d'autre part, je pense qu'il vaut mieux compter les lignes sur la colonne H, car si on a oubliée quelque chose après la validation, on va compter à partir de la colonne A, et on risque d'effacer des lignes. j'ai du mal à comprendre comment ça fonctionne avec listview, si quelqu'un peut m'aider ?
merci d'avance

Gilbert

 

[Guest]

Re : Probleme Pour Copier Une Listebox Dans Une Feuille De Mon Classeur + Autres Prob

Hello GC,

Pour comprendre listview : Utiliser le contrôle ListView en VBA Excel - Club d'entraide des développeurs francophones

A bientôt

 

[Guest]

Re : Probleme Pour Copier Une Listebox Dans Une Feuille De Mon Classeur + Autres Prob

Re Gc,

voici quelques modifications dans la procédure affichage:

Private Sub BnAfficher_Click()
    Dim clef As String                                'La clef doit être un string, servira au tri
    Dim i                                             'Compteur de quantité
    If CBétage.ListIndex = -1 Then
        MsgBox "Sélectionner une situation!", vbExclamation, "Validation ligne"
        Exit Sub
    End If
    If Me.CBtype.Value <> "" Then
    'Construction de la clef unique de l'élément ajouté
    clef = "Elem" & Format(CBétage.ListIndex, "00") & Format(CBpieceF.ListIndex, "00")
    clef = clef & Format(ListView1.ListItems.Count, "00")
        With ListView1
            .Sorted = False
            '            .ListItems.Clear
            'Remplissage 1ère colonne
            .ListItems.Add , clef, clef
            'Remplissage des colonnes suivantes
            .ListItems(.ListItems.Count).ListSubItems.Add , , CBétage
            .ListItems(.ListItems.Count).ListSubItems.Add , , Me.CBpieceF.Text
            .ListItems(.ListItems.Count).ListSubItems.Add , , Me.Label22
            .ListItems(.ListItems.Count).ListSubItems.Add , , Me.TBdesingnF.Value
            .ListItems(.ListItems.Count).ListSubItems.Add , , Me.CBlargF.Value & "X" & Me.CBhautF.Value    'dimensions
            .ListItems(.ListItems.Count).ListSubItems.Add , , Me.TBquantiF.Value    'qté
            .ListItems(.ListItems.Count).ListSubItems.Add , , Format(Me.TBprixunitF.Value, "0.00 €")    'prix u
            .ListItems(.ListItems.Count).ListSubItems.Add , , Format(Me.TBprixtotalF.Value, "0.00 €")    'prix t
            .Sorted = True
        End With
    End If
    If Me.CHKV Then                  'volet
        If TBprixensembleFV <> "" Then
            'Construction de la clef unique de l'élément ajouté
            clef = "Elem" & Format(CBétage.ListIndex, "00") & Format(CBpieceF.ListIndex, "00")
            clef = clef & Format(ListView1.ListItems.Count, "00")
            With ListView1
                .Sorted = False
                'Remplissage 1ère colonne
                .ListItems.Add , clef, clef       'situation
                'Remplissage des colonnes suivantes
                .ListItems(.ListItems.Count).ListSubItems.Add , , CBétage
                .ListItems(.ListItems.Count).ListSubItems.Add , , Me.TBpieceV.Value
                .ListItems(.ListItems.Count).ListSubItems.Add , , "Volet Roulant"
                .ListItems(.ListItems.Count).ListSubItems.Add , , Me.Label8
                .ListItems(.ListItems.Count).ListSubItems.Add , , Me.CBlargV.Value & "X" & Me.CBhautV.Value    'dimensions
                .ListItems(.ListItems.Count).ListSubItems.Add , , Me.TBquantiV.Value    'qté
                .ListItems(.ListItems.Count).ListSubItems.Add , , Format(Me.TBprixUTTCV.Value, "0.00 €")    'prix u
                .ListItems(.ListItems.Count).ListSubItems.Add , , Format(Me.TBprixtotalTTCV.Value, "0.00 €")    'prix t
                .Sorted = True
            End With
        End If
    End If
    '1ère ligne toujours sélectionnée par défaut lors de l'initialisation.
    'içi désélection
    
    If ListView1.ListItems.Count > 0 Then ListView1.ListItems(1).Selected = False
    Set ListView1.SelectedItem = Nothing
    ListView1.Refresh
    Me.CHKV.Value = False
    Call EffaceTextBox(Me, "CBpieceF", "CBétage")     'module ModPourUsf
    BnEnvoi.Enabled = True
    BnAfficher.Enabled = TBquantiF <> "" And TBprixunitF <> "" And TBprixtotalF <> ""
End Sub

Quant au problème de comptage des lignes sur colonne H je ne vois pas ce que tu veux dire.

A bientôt

 

[GCFRG]

Re : Probleme Pour Copier Une Listebox Dans Une Feuille De Mon Classeur + Autres Prob

Bonsoir le forum
salut hasco,
là plus de problème çà marche.
Consernant le comptage des lignes,dans "BNenvoi" plutôt que de selectionner la ligne sur laquelle on va écrire en comptant a partir de "A", il vaut mieux compter à partir de "H", par exemple en A11, j'ai "1er Etage" en b11 "hall" en c11 "Fenêtre Alu" d11 ....ect. en a12 rien en b12 rien mais de c12 à h12 j'ai des données.
si on à oublié une fenêtre au 1er Etage, et qu'on la rajoute, la ligne 12 sera remplacé par les nouvelles valeurs
Mais bon le problème est réglé, Je te remercie encore pour ton aide précieuse, merci également pour le lien consenant les "listview", je vais pouvoir potasser.

@ bientôt Gilbert

 

[GCFRG]

Re : Probleme Pour Copier Une Listebox Dans Une Feuille De Mon Classeur + Autres Prob

Salut le forum, Hasco, bebere
Je n'avais pas remarqué, mais les prix sont enregistrés au format texte, je n'arrive pas à les remettre au format monétaire ou nombre
j'ai regardé dans le document dont tu m'avais indiquer le lien, j' essayé Cdec, mais rien n'y fais. je tourne en rond .
Désolé de sollciter encore votre aide !

Glibert

 

[Bebere]

Re : Probleme Pour Copier Une Listebox Dans Une Feuille De Mon Classeur + Autres Prob

bonjour Gcfrg,Hasco,le Forum
tu as la solution dans une version précédente
'Boucle sur les colonnes
For C = 1 To ListView1.ColumnHeaders.Count - 1
.Cells(DerLig + L, C + 1) = ListView1.ListItems(L).ListSubItems(C).Text
If C = 5 Then .Cells(DerLig + L, C + 1) = CDbl(ListView1.ListItems(L).ListSubItems(C).Text)
If C > 5 Then
.Cells(DerLig + L, C + 1) = CDbl(Replace(ListView1.ListItems(L).ListSubItems(C).Text, " €", ""))
.Cells(DerLig + L, C + 1).NumberFormat = "0.00 €"
End If
Next C
une question,les prix non connus tu ne pense pas à les écrire dans les feuilles ou ils manquent,et si tes prix changent???

essaye de mettre un exemple avant après pour élimininer doublons situation,pièces

à bientôt

 

[GCFRG]

Re : Probleme Pour Copier Une Listebox Dans Une Feuille De Mon Classeur + Autres Prob

Salut le forum, bebere, hasco,

Merci bébere, j'ai adapté le code comme suit:

 Private Sub BnEnvoi_Click()
    Dim DerLig As Integer, i As Integer, j As Byte
    Dim Ctl As Control
    Dim Situation As String
    Dim Piece As String
    Dim Déb   As String
    Dim Fin As String
    With Sheets("feuil4")
        ' Récupérer la dernière ligne remplie
        DerLig = .Range("h" & .Rows.Count).End(xlUp).Row

        'Boucle sur toutes les lignes
        For i = 1 To ListView1.ListItems.Count
            
            'Changement de situation?
            If Situation <> Left(ListView1.ListItems(i).Text, 6) Then
                Situation = Left(ListView1.ListItems(i).Text, 6)
                .Cells(DerLig + i, 1) = ListView1.ListItems(i).ListSubItems(1).Text
                Déb = .Cells(DerLig + i, 1).Row
            End If
            
            'Changement de pièce
            If Piece <> Mid(ListView1.ListItems(i).Text, 7, 2) Then
                Piece = Mid(ListView1.ListItems(i).Text, 7, 2)
                .Cells(DerLig + i, 2) = ListView1.ListItems(i).ListSubItems(2).Text
            End If
            
            'Boucle sur les autres colonnes
            For j = 3 To ListView1.ColumnHeaders.Count - 4
                .Cells(DerLig + i, j) = ListView1.ListItems(i).ListSubItems(j).Text
                Next j
            For j = 6 To ListView1.ColumnHeaders.Count - 1
                .Cells(DerLig + i, j) = CDbl(Replace(ListView1.ListItems(i).ListSubItems(j).Text, " €", ""))
                Next j
        Next i
        Fin = .Cells(DerLig + i - 1, j).Row
        .Cells(DerLig + i, j - 2).Value = "Total TTC"
        .Cells(DerLig + i, j - 1).FormulaR1C1 = "=sum(r" & Déb & "c8:r" & Fin & "c8)"
        End With

    ListView1.ListItems.Clear
    'Elimine Ligne

    For Each Ctl In Frame1.Controls
        If InStr("CBpieceF,CHKALU,CHKPVC,bnEnvoi", Ctl.Name) = 0 Then
            Ctl.Enabled = False
        End If

    Next Ctl

    CHKALU.SetFocus

    BnEnvoi.Enabled = False

End Sub

çà fonctionne plutôt bien, un peu galeré pour le total mais çà commence à rentrer
Merci encore pour tous votre travail à toi et hasco, sans vous je n'avais plus de boulot aujoud'hui.
concernant les prix manquants. Les différents tableaux sont en cour de réalisation.

On travaille sur des ratios au mètre carré, les prix sont à indexé sur l'indice du batiment, je devrais également créer une procédure qui devra mettre à jour tous les prix présent dans ces feuilles en fonction de cet indice.

Je vais maintenant m'attaquer aux autres modules " Gros oeuvre, garage, chassis de toit, abris de jardin et j'en passe!!", ceci devrais permettre de calculer le prix d'une construction de maison individuelle de maniere assez précise, un chiffage rapide pour les commerciaux, en quelque sorte, avant devis définitif.

Je suppose que j'aurais encore l'occasion de solliciter votre aide.
encore Merci
@+ Gilbert