Un dernier et apres j'arrete: pb de definition de ligne

[Payou]

Bonjour a tous, le forum.

Bon un dernier message et apres j'arrete de spamer ce bon vieux forum et en laisse un peu pour les autres. Je debute, alors mes problemes sont nombreux, et je suis toujours en attente de livraisons de bon bouquin sur la VBA, donc vous etes mon seul recours, puis surtout recours efficace lol.

Don voila j'ai le code suivant:

[COLOR="Red"]Dim i As ActiveSheet.Rows.(ActiveCell.Row).MergeArea[/COLOR]
     If i.Value = "" Then
    [COLOR="YellowGreen"]ActiveSheet.Rows(ActiveCell.Row).Columns("A").Select[/COLOR]
    With Selection.Interior 'to change the color of the line when there is nothing in
        .ColorIndex = 48
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
    End If

Mais il me pose probleme car il ne fonctionne pas des la premiere ligne... En fait le reste fonctionne si je met pas mon dim etc et que je commence a la ligne verte.

Mais voila si je fais ca ca ne me donne pas ce que je veux. J'aimerais que si toutes les lignes comprises par la cellule en colonne A de ma ligne active sont vides alors seulememt il me change la couleur de ma cellule fusionnee en gris... Parce que en partant de la ligne verte a partir du momnent ou la ligne selectionner est vide, il me met ma cellule fusionnee en gris, alors que la ligne d'en dessous, et qui se rapporte a ma cellule fusionnee contient des donnees.

Autrement dit, si dans les 3 lignes que comprends ma cellule fusionnee (par exemple) en colonne A, il faut que toutes celles-ci soit vides pour que ma cellule fusionnee deviennent grise.

J'ai deja essayer plein de trucs, en supprimant une partie de la ligne rouge, la rallongeant avec d'autres rien n'y fait, XL fait sa tete de mule !

Bon j'espere avoir ete le plus comprehensible possible dans mon discours. Si jamais n'hesitez pas a me demander des precisions :S

Merci beaucoup a tous,

Payou

Edit: J'upload le fichier, afin que si jamais vous puissiez me comprendre. Dans le fichier vous trouverez ce que la macro me fait actuellement, donc vous comprendrez mieux pourquoi j'aimerais faire la modif.

 

[JNP]

Re : Un dernier et apres j'arrete: pb de definition de ligne

Bonjour Payou ,
C'est sur qu'en déclarant comme type de variable le contenu de la variable, ça va pas le faire ... Le code serait plutôt de ce type

[COLOR=#ff0000]Dim i[/COLOR]
[COLOR=#ff0000]I = ActiveSheet.Rows.(ActiveCell.Row).MergeArea[/COLOR]

Maintenant, je ne vois pas trop ce que ça va donner, la 2° ligne est en erreur aussi...
La logique serait plutôt

[COLOR=#ff0000]I = ActiveSheet.ActiveCell.MergeArea[/COLOR]

mais bon, ça n'engage que moi .
Bonne journée

 

[Payou]

Re : Un dernier et apres j'arrete: pb de definition de ligne

Bonjour JNP, un grand merci pour venir me secourir.

Par contre j'ai une mauvaise nouvelle, aucune des 2 solutions ne fonctionne :S
J'espere que tu trouvera l'inspiration et que tu auras une autre idee pour mon probleme car il me serait utile d'avoir une solution...

Merci beaucoup ent out cas.

Payou

 

[Payou]

Re : Un dernier et apres j'arrete: pb de definition de ligne

Bonjour a tous, j'espere que votre reveil n'a pas ete trop difficile et que vous avez vos neurones en ebulition car j'ai peu etre du nouveau, JE VIENS DE GAGNER UNE LIGNE LOL. Et oui aussi fou que cela ppuisse paraitre j'ai fait avancer le schmilblick d'une ligne lol.

Dim i
    i = ActiveCell.MergeArea.Columns("B:U")
     [COLOR="Red"]If i.Value = "" Then[/COLOR]
    ActiveSheet.Rows(ActiveCell.Row).Columns("A").Select
    With Selection.Interior 'to change the color of the line when there is nothing in
        .ColorIndex = 48
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
    End If

Maintenant ca bloque a la ligne en rouge... Comprends pas, pourtant l'est pas bein compliquee celle-ci En meme temps je suis pas plus sur que ca de ma premiere ligne lol.

Il me met le probleme suivant: "Object requierd". Euh, bah comment dire, c'est ce que j'aimerais justement qu'il n'y ai pas d'objet !!

Si jamais vous avez ne seraisse qu'une once d'idee je prends

Bonne journee a tous.

Payou

 

[eriiic]

Re : Un dernier et apres j'arrete: pb de definition de ligne

Bonjour,

Si tes cellules sont fusionnées seule la 1ère à une valeur.
essaie ça :

    Dim r As Range
    Set r = Cells(ActiveCell.Row, 1).MergeArea
    With r
        If .Cells(1, 1) = "" Then
            With .Interior    'to change the color of the line when there is nothing in
                .ColorIndex = 48
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
            End With
        End If
    End With
    Set r = Nothing

eric

 

[Payou]

Re : Un dernier et apres j'arrete: pb de definition de ligne

Bonjour Eric, merci de te joindre a mon probleme !!!

Effectivement maintenant ca ne bug plus

Mais me reste un leger problem, la cellule en colonne "A" ne se colorie pas en gris, mais reste comme elle est...

Mais merci d'avoir deja resolu mon probleme de bug

Payou

EDIT j'ai comme un doute

Si tes cellules sont fusionnées seule la 1ère à une valeur.
essaie ça :

Je sais pas si tu as ouvert le fichier, mais seul la colonne A comprends des cellules fusionnees. apres a partir de la colonne B, les lignes redeviennent "normales".

 

[eriiic]

Re : Un dernier et apres j'arrete: pb de definition de ligne

Je sais pas si tu as ouvert le fichier heuuu non, maintenant c'est fait ;-)

Si tu as A11:A13 de fusionnées, la valeur est dans A11. D'où le .cells(1,1)
J'avoue avoir eu du mal à comprendre ce que tu voulais...
J'ai compris que si en colonne A, même ligne que ton curseur, la cellule est vide alors griser la (les) cellules en colonne A.
Sur ton classeur si je vide A11:A13 cette plage se grise avec le bout de code que je t'ai donné.
Ce n'est pas ça ?

Au passage, comme je suis nouveau sur ce forum, sais-tu comment on peut visualiser les posts auquel on a participé et uniquement ceux-là ?

 

[Payou]

Re : Un dernier et apres j'arrete: pb de definition de ligne

Bon je vais commencer par repondre a ta question pour les post:

Tu peux visualiser toutes les discussions ou tu a participer en cliquant sur ton pseudo en haut a droite a cote du bienvenu, et apres c'est le deuxieme onglet je crois. Et encore c'est pas tout a fait ce que tu veux je pense...


Pour ce qui est de mon probleme, en fait j'aimerais que lorsque toute les lignes qui sont comprises dans la cellule fusionnee, cad si en colonne A les lignes 1,2,3 sont fusionnees alors si les lignes 1,2,3 (a partir de la colonne "B") sont vides, alors ma cellule fusionnee en colonne A se grise.

Punaise c'est vrai que je suis pas tres clair... Si jamais tu n'as toujours pas compris, je referais une tentative

Merci de m'aider !!
Payou

 

[C@thy]

Re : Un dernier et apres j'arrete: pb de definition de ligne

Bravo à vous deux et BIENVENUE A Eriiiic!

C@thy

 

[Payou]

Re : Un dernier et apres j'arrete: pb de definition de ligne

Bonjour C@thy,

Euh pourquoi bravo ? Ah Eriiiic je veux bien, car il me donne un coup de main mais moi pourquoi? Pour reussir a trouver des problemes lol ?

Payou

 

[eriiic]

Re : Un dernier et apres j'arrete: pb de definition de ligne

Si si, tu as donné une bonne réponse... ;-)

Donc plutôt ça alors ?

    Dim r As Range
    Set r = Cells(ActiveCell.Row, 1).MergeArea
    If Application.CountA(r.EntireRow) - Application.CountA(r) = 0 Then
        With r
            With .Interior    'to change the color of the line when there is nothing in
                .ColorIndex = 48
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
            End With
        End With
    End If
    Set r = Nothing

 

[Payou]

Re : Un dernier et apres j'arrete: pb de definition de ligne

Eriiic, heureux de te revoir aussi vite

J'ai essayer ton nouveau code, mais il ne fonctionne pas malheuresement sur ma feuille. Je vais l'essayer sur la feuille que je t'ai fait parvenir pour voir si le probleme viens de plus haut...

Merci de ne pas me lacher

Payou

 

[Payou]

Re : Un dernier et apres j'arrete: pb de definition de ligne

Coucou,

Arf il fonctionne bien voir meme tres bien sur la feuille que je t'ai fait parvenir, je dois avoir une c***lle plus haut... Je vais essayer de voir si je trouve une truc :S puis je vais reessayer, mais visiblement ton code est parfait, donc je voulais te dire un grand merci, et chapeau.

Passse une belle journee

Payou

 

[Payou]

Re : Un dernier et apres j'arrete: pb de definition de ligne

Le forum, Eriiiic,

Bon je sais j'abuse, je suis un profiteur de tout votre savoir, et tout, mais la je comprends pas...

Je met le code, pour voir si vous vous y comprennez qq'chose :S

Sub xXx()
'This macro permit to copy the selected item from the DB, to the goods out, and erase it from the DB.
'It also launch an update of the other folder to be an up to date folder

Application.ScreenUpdating = False 'permit to gain time by blocking the view

ActiveSheet.Rows(ActiveCell.Row).Columns("B:U").Copy
    Sheets("Goods out").Select
    Sheets("Goods out").Range("L65536").End(xlUp).Offset(1, 0).Select 'Select the first empty cell in the column L
    ActiveSheet.Rows(ActiveCell.Row).Columns("B:U").Select 'Select the row in wich the cell was empty
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        
If Cells(Selection.Row, 18).Value > 0 Then 'Permit to not remove from the data base if there is still stock

    ActiveSheet.Rows(ActiveCell.Row).Columns("B:U").Select
    Selection.Copy
    
Worksheets("Data Base").Activate

ActiveSheet.Rows(ActiveCell.Row).Columns("B:U").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        
Else 'If there is no more stock, permit to remove it from stock

    Worksheets("Data Base").Activate
    ActiveSheet.Rows(ActiveCell.Row).Columns("B:U").Select
    Selection.ClearContents
    
    Dim r As Range
    Set r = Cells(ActiveCell.Row, 1).MergeArea
    If Application.CountA(r.EntireRow) - Application.CountA(r) = 0 Then
        With r
            With .Interior    'to change the color of the line when there is nothing in
                .ColorIndex = 48
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
            End With
        End With
    End If
    Set r = Nothing

End If

End Sub
Merci en tout cas a Eriiic et sa formule

Payou

 

[eriiic]

Re : Un dernier et apres j'arrete: pb de definition de ligne

Dans ton fichier exemple il n'y a pas de formule.
Ca a changé depuis ? Si c'est le cas forcement ça ne marchera plus car ="" est une valeur qui est comptée...

Par ailleurs je complète ma question, comment voir les posts auquels on a participé qui ont eu une nouvelle réponse ?

EDIT:
sinon la methode forte (adapter [B:Z] aux colonnes à tester):

   Dim r As Range
    Set r = Cells(ActiveCell.Row, 1).MergeArea
    ok = True
    For Each c In Intersect(r.EntireRow, [B:Z])
        If c.Value <> "" Then
            ok = False
            Exit For
        End If
    Next c
    If ok Then
        With r
            With .Interior    'to change the color of the line when there is nothing in
                .ColorIndex = 48
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
            End With
        End With
    End If
    Set r = Nothing