VBA excel hauteur de ligne homogène [débutant] [Résolu]

Messages postés
5
Date d'inscription
vendredi 18 juin 2010
Dernière intervention
30 décembre 2011
- - Dernière réponse : Merowig
Messages postés
5
Date d'inscription
vendredi 18 juin 2010
Dernière intervention
30 décembre 2011
- 30 déc. 2011 à 13:26
Bonjour,
je souhaite faire une fonction qui semble facile...
Dans une cellule excel, je souhaite déterminer (filtrer) le nombre de retour chariot (Chr(10))afin d'augmenter ou de diminuer la hauteur de la ligne entière (Rowheight) de la cellule.

[*] la cellule appartient toujour à la collonne B
[*] La hauteur de la ligne doit être un multiple de 12.75 pour 0 Chr(10), de 25.5 pour 1 Chr(10), de 38.25 pour 3 Chr(10), etc etc...

Donc mon code :
détermine la zone des cellules concernées
sur chaque cellule un filtre s'applique pour rechercher les éventuels Chr(10)
On multiplie le nombre trouvé par 12.75
on applique la hauteur de la ligne concernée.

Ce qui me pose problème :
...
For a = 1 To nbrligne [détermine la zone]
textecellule = ActiveSheet.Range("B" & a) [permet de récupérer la valeur d'une cellule de la zone]
retourchariot = Filter(textecellule, Chr(10), True)[erreur]
...


A votre avis, la fonction filter est elle la mieux adapté?
Et existe t'il déja un code?

Merci d'avance
Afficher la suite 

Votre réponse

6 réponses

Meilleure réponse
Messages postés
24594
Date d'inscription
mercredi 22 octobre 2003
Statut
Contributeur
Dernière intervention
20 février 2019
362
3
Merci
Bonjour,

Essayes ce code là :

Sub test_chr()
Dim TexteCell As String
nblignes = 10 ; Nb lignes max à traiter.

For a = 1 To nblignes
    TexteCell = Range("B" & a).Value ' recuperation du texte
    nbChr = CountOccu(TexteCell, Chr(10))
    Debug.Print nbChr
Next

End Sub



Public Function CountOccu(ByRef vsInput As String, ByRef vsPattern As String, Optional ByVal veCompare As VbCompareMethod = vbBinaryCompare) As Integer
Dim i As Long
    i = InStr(1, vsInput, vsPattern, veCompare)
    Do While i
        CountOccu = CountOccu + 1
        i = InStr(i + 1, vsInput, vsPattern, veCompare)
    Loop
    
End Function




Ne reste plus qu'à l'adapter à tes besoins

Cordialement,
Jordane,
______________________________________________________
Règles du forum à lire avant de poster une question : ICI

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 121 internautes nous ont dit merci ce mois-ci

Commenter la réponse de jordane45
Messages postés
24594
Date d'inscription
mercredi 22 octobre 2003
Statut
Contributeur
Dernière intervention
20 février 2019
362
3
Merci
Hello,

Pas besoin de remettre une boucle.
Tu peux directement faire ta multiplication à la suite de la récupération du nombre de retours chariots.


Avec ce code..ça marche:
Sub Redim_chr()
Dim TexteCell As String
nblignes = 10 ' Nb lignes max à traiter.

For a = 1 To nblignes
    TexteCell = Range("B" & a).Value ' recuperation du texte
    'Nb de retours chariots dans la cellule :
    nbChr = CountOccu(TexteCell, Chr(10))
        Debug.Print nbChr
    
        
    'Taille à mettre sur la ligne :
    Nouvelle_Taille = nbChr * 12.75 + 12.75
        Debug.Print Nouvelle_Taille
    
    'Application de la taille dans la ligne (a) :
    ActiveSheet.Rows(a).RowHeight = Nouvelle_Taille
    
    
Next

End Sub



Public Function CountOccu(ByRef vsInput As String, ByRef vsPattern As String, Optional ByVal veCompare As VbCompareMethod = vbBinaryCompare) As Integer
Dim i As Long
    i = InStr(1, vsInput, vsPattern, veCompare)
    Do While i
        CountOccu = CountOccu + 1
        i = InStr(i + 1, vsInput, vsPattern, veCompare)
    Loop
    
End Function



PS : Utilises les balises de code lorsque tu copie du code dans le forum. (3eme icone en partant de la droite dans la barre d'outils )


Cordialement,
Jordane,
______________________________________________________
Règles du forum à lire avant de poster une question : ICI

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 121 internautes nous ont dit merci ce mois-ci

Commenter la réponse de jordane45
Messages postés
24594
Date d'inscription
mercredi 22 octobre 2003
Statut
Contributeur
Dernière intervention
20 février 2019
362
3
Merci
Et pour gagner du temps dans le traitement, désactive l'affichage pendant le traitement.

Application.ScreenUpdating = False


puis remets le à TRUE à la fin de ton traitement.
tu verras...ça va beaucoup plus vite

Cordialement,
Jordane,
______________________________________________________
Règles du forum à lire avant de poster une question : ICI

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 121 internautes nous ont dit merci ce mois-ci

Commenter la réponse de jordane45
Messages postés
5
Date d'inscription
vendredi 18 juin 2010
Dernière intervention
30 décembre 2011
0
Merci
Salut Jordane et merci pour ta réponse
Je comprends la première partie du code (fonction test_Chr), qui marche super, le nombre de retour Chariot et juste,en plus elle est optimisée,

De plus j'ai appris l'utilité d'une fonction publique

par contre, si je veux muliplier le nombre de "Chr10" de chaque case controlées par 12.75 (hauteur de ligne), dois je y mettre dans la boucle "For a =1 to ..."

Pour que le programme décompte les Chr et tout de suite il adapte le Rowheight?

With ThisWorkbook.ActiveSheet
lastcell = ActiveSheet.Range("B10000").End(xlUp).Row
nbrlignes = lastcell ' Nb lignes max à traiter.
For a = 1 To nbrlignes
TexteCell = ActiveSheet.Range("B" & a).Value ' recuperation du texte
nbChr = CountOccu(TexteCell, Chr(10))
ActiveSheet.Range("B" & a).Select
Debug.Print nbChr

For b = 1 To nbChr
ActiveSheet.Range("B" & a).RowHeight = ActiveSheet.Range("B" & a).RowHeight * 12.75 'rien ne se passe
Next b

Next a

End With

End Sub
Public Function CountOccu(ByRef vsInput As String, ByRef vsPattern As String, Optional ByVal veCompare As VbCompareMethod = vbBinaryCompare) As Integer

Dim i As Long
vsInput = 10


i = InStr(1, vsInput, vsPattern, veCompare)
Do While i
CountOccu = CountOccu + 1
i = InStr(i + 1, vsInput, vsPattern, veCompare)
Loop

End Function


Dans tous les cas, je valide ta réponse merci.
Commenter la réponse de Merowig
Messages postés
5
Date d'inscription
vendredi 18 juin 2010
Dernière intervention
30 décembre 2011
0
Merci
Re.-
Oui bien sur, très bien comme ça



Private Sub CommandButton9_Click()
Dim nbrlignes
Dim a
Dim nbChr
Dim TexteCellule As String
Dim lastcell
Dim tailleligne


With ThisWorkbook.ActiveSheet
lastcell = ActiveSheet.Range("B1000").End(xlUp).Row
nbrlignes = lastcell ' Nb lignes max à traiter.

For a = 1 To nbrlignes

TexteCellule = Range("B" & a).Value ' recuperation du texte

nbChr = CountOccu(TexteCellule, Chr(10))
tailleligne = 12.75 + 12.75 * (nbChr)
Range("B" & a).RowHeight = tailleligne
Debug.Print nbChr

Next a

End With

End Sub
Public Function CountOccu(ByRef vsInput As String, ByRef vsPattern As String, Optional ByVal veCompare As VbCompareMethod = vbBinaryCompare) As Integer

Dim i As Long



    i = InStr(1, vsInput, vsPattern, veCompare)
    Do While i
        CountOccu = CountOccu + 1
        i = InStr(i + 1, vsInput, vsPattern, veCompare)
    Loop
    
End Function




Bon, ça ralentit pas mal le process, mais après tout c'est le PC travaille

Maintenant détection de modif sur feuille excel, mais ça c'est un autre post.
Merci de ton aide, jordane
Cordialement.
Commenter la réponse de Merowig
Messages postés
5
Date d'inscription
vendredi 18 juin 2010
Dernière intervention
30 décembre 2011
0
Merci
[^^sad2]
Commenter la réponse de Merowig

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.