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 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