Amélioration du code

Bonsoir à tous

j'ai modifié ce code que j'ai dans mon fichier, pour avoir une hauteur (22) et centré sur la ligne.

Private Sub BtnValid_ExtracSDO_Click()

Dim Lg As Long
Dim D1$, D2$
Dim WsS As Worksheet

   'Procédure effacer zone du tableau de bord pour recevoir nouvelles données

   Lg = Range("B8").End(xlUp).Row + 1
   Range("B" & Lg & ":B60000").EntireRow.Delete

   'Procédure Fitre  du tableau LISTING PUIS Extraction vers Tableau de Bord
   Set WsS = Worksheets("DataBase")
   WsS.ListObjects("TDataBase").Range.AutoFilter Field:=10      'Réinitialiser le filtre SDO

   WsS.ListObjects("TDataBase").Range.AutoFilter Field:=10, _
            Criteria1:=">=" & CboNsem_Deb, Operator:=xlAnd, Criteria2:="<=" & CboNsem_Fin      ' Fitre sur SDO entre CboNsem_Deb et CboNsem_Fin
   WsS.ListObjects("TDataBase").DataBodyRange.Copy [B8]      'Copie vers Tableau de Bord

   Range("B" & Lg & ":B60000").EntireRow.RowHeight = 22 'mettre la ligne à la hauteur = 22
   Range("B" & Lg & ":B60000").EntireRow.VerticalAlignment = xlCenter 'Ligne centrée

   WsS.ListObjects("TDataBase").Range.AutoFilter Field:=10      'Réinitialiser le filtre du Tableau Listing SDO
End Sub

je suppose qu'il est possible de grouper les 3 Range("B" & Lg & ":B60000").EntireRow avec with , mais je tourne en rond dessus sans y parvenir.

De même serait il possible de pouvoir réduire les ligne en dessous .

pour la valeur de la hauteur est il possible que je l'assigne à une cellule (T2 de la feuil3)

J'espère être clair et que ma demande ne soit pas trop importante

Merci de vos réponses

Ledzep

Bonjour,

With Range("B" & Lg & ":B60000").EntireRow
    .RowHeight = Sheets("Feuil3").[T2].Value    'mettre la ligne à la hauteur = 22
    .VerticalAlignment = xlCenter    'Ligne centrée
End With

Le 1er je le trouve un peu trop éloigné mais si tu veux démarrer le With là-haut tu peux.

eric

Bonsoir à tous

Bonsoir eriiic

Le code fonctionne, j'ai seulement dû modifier ("Feuil3"), mais cela est de ma faute puisque ds ma demande c'est ce j'ai mis

J'ai essayé de faire comme tu m'as suggéré, de mettre en début le With pour encore simplifier le code, mais j'avais un doute puisque

je réalise la suppression des données antérieures pour mettre la nouvelle sélection.

Cela me bloque vba

Je suis resté sur ta proposition.

Maintenant, j'ai aussi compris pourquoi cela ne pouvais pas fonctionner Mon with était mal positionné .

Merci de ton aide, et petit à petit je me forme, mais je suis très très loin de vos capacités....

Bonne soirée et bon week à tous

Ledzep

Si, tu pouvais.

Tu peux même mettre un autre With à l'intérieur :

Private Sub BtnValid_ExtracSDO_Click()
    Dim Lg As Long
    Dim D1$, D2$
    Dim WsS As Worksheet

    'Procédure effacer zone du tableau de bord pour recevoir nouvelles données
    Lg = Range("B8").End(xlUp).Row + 1
    With Range("B" & Lg & ":B60000").EntireRow
        .Delete
        'Procédure Fitre  du tableau LISTING PUIS Extraction vers Tableau de Bord
        Set WsS = Worksheets("DataBase")
        With WsS.ListObjects("TDataBase")
            .Range.AutoFilter Field:=10    'Réinitialiser le filtre SDO
            .Range.AutoFilter Field:=10, _
                    Criteria1:=">=" & CboNsem_Deb, Operator:=xlAnd, Criteria2:="<=" & CboNsem_Fin                            ' Fitre sur SDO entre CboNsem_Deb et CboNsem_Fin
            .DataBodyRange.Copy [B8]    'Copie vers Tableau de Bord
        End With
        .RowHeight = 22    'mettre la ligne à la hauteur = 22
        .EntireRow.VerticalAlignment = xlCenter    'Ligne centrée
    End With
    WsS.ListObjects("TDataBase").Range.AutoFilter Field:=10        'Réinitialiser le filtre du Tableau Listing SDO
End Sub

Si tu indentes bien ton code tu t'y retrouveras facilement.

Si tu ne l'as pas encore mis je te conseille d'installer l'addin Smart Indenter qui le fait très bien. Tu vois tout de suite les erreurs de structure.

Il semble qu'il y ait un soucis avec le site de l'auteur, si besoin je te l'uploaderai...

eric

Bonsoir à tous

Bonsoir eriic

Voici mon code final qui fonctionne bien 'pour moi'

'G- PROCEDURE FILTRE SUR SECTEUR EXPLOITATION DEPUIS CHOIX EN "CboNsem_Deb" et CboNsem_Fin Ds FEUILLE "TABLEAU DE BORD"

    Private Sub BtnValid_ExtracSDO_Click()

    Dim Lg As Long
    Dim D1$, D2$
    Dim WsS As Worksheet

    'G1- Procédure effacer zone du Tbl de bord pour recevoir nouvelles données

    Lg = Range("B8").End(xlUp).Row + 1           'Départ de la ligne sélectionné de B8
    With Range("B" & Lg & ":B600").EntireRow     'A B600
        .Delete                                  'Nettoyage

    'G2- Procédure Fitre du tableau DataBase PUIS EXTRACTION vers Tableau de Bord

        Set WsS = Worksheets("DataBase")        'Identification de la feuille objet
        With WsS.ListObjects("TDataBase")
            '.Range.AutoFilter Field:=10        'Réinitialiser le filtre SDO "Doublon vérifier pour sup"
            .Range.AutoFilter Field:=10, _
                Criteria1:=">=" & CboNsem_Deb, Operator:=xlAnd, Criteria2:="<=" & CboNsem_Fin    ' Filtre sur SDO entre CboNsem_Deb et CboNsem_Fin
            .DataBodyRange.Copy [B8]            'Copie vers Tableau de Bord
            .Range.AutoFilter Field:=10         'Réinitialiser le filtre du Tableau Listing SDO
        End With
     End With

   'G3- Procédure Fitre du tableau DataBase PUIS EXTRACTION vers Tableau de Bord

    With Range("B" & Lg & ":B600").EntireRow
        .RowHeight = Sheets("Administrateur").[T3].Value    'Mettre la ligne à la hauteur suivant valeur de cel T3 Feuil Admin
        .VerticalAlignment = xlCenter    'Centrée
        .Font.Color = RGB(0, 0, 0)       'Couleur police
        .Font.Bold = True                'Ecriture en Gras
    End With

    End Sub

J'ai mis des commentaires supplémentaires pouvez vous me valider si c'est bon svp, merci

Pour la proposition de Smart Indenter , je suis ok, j'ai regardé, mais il y a 2 versions dont une qui ne fonctionne pas ou plus.

Donc oui pour l'up avec la méthode d'installation stp

Merci.

Bonne fin de journée

Ledzep

Bonjour,

    With Range("B" & Lg & ":B600").EntireRow
    ' .... 
    End With
    'G3- Procédure Fitre du tableau DataBase PUIS EXTRACTION vers Tableau de Bord
    With Range("B" & Lg & ":B600").EntireRow

Pourquoi le fermer pour le rouvrir aussitôt ?

Pour Smart Indenter je ne connais qu'une version.

Il suffit de lancer l'exe

eric

Bonsoir à tous

Bonsoir eriic

Pour répondre à ton interrogation au sujet

With Range("B" & Lg & ":B600").EntireRow
    ' .... 
    End With
    'G3- Procédure Filtre du tableau DataBase PUIS EXTRACTION vers Tableau de Bord
    With Range("B" & Lg & ":B600").EntireRow

Sinon erreur 424 objet requis sur

Range("B" & Lg & ":B600").EntireRow

Voila pourquoi

as tu une explication ?

Bonne soirée

Ledzep

Bonjour,

maisd il faut supprimer

    End With

ET

    With Range("B" & Lg & ":B600").EntireRow

complètement.

eric

Bonsoir à tous

Bonsoir eriiic

Ok pour ton conseille, j'avais essayé de faire cette action, mais j'avais eu la même erreur.

J'ai de nouveau fait ce que tu me propose, en suivant ton conseille

'G- PROCEDURE FILTRE SUR SECTEUR EXPLOITATION DEPUIS CHOIX EN "CboNsem_Deb" et CboNsem_Fin Ds FEUILLE "TABLEAU DE BORD"

    Private Sub BtnValid_ExtracSDO_Click()

    Dim Lg As Long
    Dim D1$, D2$
    Dim WsS As Worksheet

    'G1- Procédure effacer zone du Tbl de bord pour recevoir nouvelles données

    Lg = Range("B8").End(xlUp).Row + 1           'Départ de la ligne sélectionné de B8
    With Range("B" & Lg & ":B600").EntireRow     'A B600
        .Delete                                  'Nettoyage

    'G2- Procédure Fitre du tableau DataBase PUIS EXTRACTION vers Tableau de Bord

        Set WsS = Worksheets("DataBase")        'Identification de la feuille objet
        With WsS.ListObjects("TDataBase")
            '.Range.AutoFilter Field:=10        'Réinitialiser le filtre SDO "Doublon vérifier pour sup"
            .Range.AutoFilter Field:=10, _
                Criteria1:=">=" & CboNsem_Deb, Operator:=xlAnd, Criteria2:="<=" & CboNsem_Fin    ' Filtre sur SDO entre CboNsem_Deb et CboNsem_Fin
            .Range.AutoFilter Field:=12, Criteria1:=" <>clot"           'Filtre suprimme clot
            .DataBodyRange.Copy [B8]            'Copie vers Tableau de Bord
            .Range.AutoFilter Field:=10         'Réinitialiser le filtre du Tableau DataBase SDO
            .Range.AutoFilter Field:=12         'Réinitialiser le filtre du Tableau DataBase suprimme clot
        End With

   'G3- Procédure gestion écriture des résultats dans Tableau de Bord

       .RowHeight = Sheets("Administrateur").[T3].Value   'Mettre la ligne à la hauteur suivant valeur de cel T3 Feuil Admin
        .VerticalAlignment = xlCenter    'Centrée
        .Font.Color = RGB(0, 0, 0)       'Couleur police
        .Font.Bold = True                'Ecriture en Gras
    End With

    End Sub

L'erreur 424 Objet requis est sur la ligne

.RowHeight = Sheets("Administrateur").[T3].Value

Bonne soirée

Ledzep

Bonjour,

ok, j'ai compris.

Le .Delete a supprimé la plage du premier With qui devient Nothing, d'où échec ensuite.

Du coup ce 1er With n'est plus vraiment justifié. Mettre directement :

Range("B" & Lg & ":B600").EntireRow.Delete

Par contre le mettre en bas comme tu avais fait.

eric

Bonsoir à tous

Bonsoir eriic

Entendu.

Merci pour ton aide sur ce sujet.

Je continue mon projet.

Maintenant je passe par l'impression de la feuille tableau de bord.

A bientôt sur le forum

Ledzep

Rechercher des sujets similaires à "amelioration code"