recentrage automatique d'un tableau Résolu

Question

Bonjour et bonne année 2016 à tous,

J’ai créé une fonction macro recentrage sous Excel 2003. Pas de problème à ce niveau.

Mon problème c’est que je souhaiterais que la sélection soit automatique quelque soit l’emplacement du tableau (donc uniquement une sélection de la zone de donnée) mais je ne trouve pas la solution.

Ci-joint un fichier d’exemple : https://www.cjoint.com/c/FAgqSjEp6gt

Merci de votre aide

Cordialement

ccm81 · Answer

Bonjour

Difficile même avec ton exemple de comprendre ce que tu veux; peux tu compléter tes explications.
Du genre
J'ai un tableau en C4:K8, je veux .....

Cdlmnt

mijean94 · Answer

Bonjour,

Quelque soit l’emplacement du tableau sur la feuille, je souhaite le sélectionner puis le replacer sur le haut de la feuille.

Cordialement

ccm81 · Answer

Un exemple avec ce que j'ai compris 
http://www.cjoint.com/c/FAgrRI3GCkk 

Cdlmnt

mijean94 · Answer

Ta solution marche très bien pour moi, merci.
Est-il possible que la sélection soit automatique ?  

Cordialement

ccm81 · Answer

Essaies ceci

Const celcible = "A1"Sub recentrage()Dim derlig As Long, dercol As Long, plage As RangeDim premlig As Long, premcol As Longderlig = Cells.Find("*", , , , xlByRows, xlPrevious).Rowpremlig = Cells.Find("*", , , , xlByRows, xlNext).Rowdercol = Cells.Find("*", , , , xlByColumns, xlPrevious).Columnpremcol = Cells.Find("*", , , , xlByColumns, xlNext).ColumnSet plage = Range(Cells(premlig, premcol), Cells(derlig, dercol))plage.Cut Destination:=Range(celcible)End Sub
Cdlmnt

mijean94 · Answer

Je rame depuis plus de 30 minutes pour comprendre pourquoi ta fonction (ccm81-9) qui marche si bien dans les exemples ne fonctionnée pas sur mon fichier.

 Et voila pourquoi :

Dans mon ficher, les colonnes A et B et les lignes 1 et 2 ne doivent pas être prises en compte !
Le point de recalage haut doit être C3.

Aurais-tu une petite modification à me proposer ?

https://www.cjoint.com/c/FAgvhKNLdwt

Merci

Cordialement

ccm81 · Answer

Je ne comprends pas bien le problème, sur ton fichier exemple
PremLifg = 9
PremCol = 6 (F)
DerLig = 42
DerCol = 18 (R)
Ce qui définit la plage rectangulaire F9:R42
qui est bien déplacée en C3:O36 après exécution
Ce n'est pas ce que tu veux ?

Cdlmnt

mijean94 · Answer

OK ccm81, toutes mes excuses, je n’avais pas remarqué que mon bouton de commande macro pointé sur une autre version de fichier avec le positionnement en A1. pb lorsque j'ai sauvegardé le fichier de la version 4 à la version 5.

Ça marche donc très bien. Merci


Comment faut-il faire pour que les macros soient toujours bien accrochée au fichier sauvegardé en cas de changement de nom? 

Cordialement

ccm81 · Answer

En principe un "eregistrer sous" conserve le lien du raccourci-clavier vers la macro.
Par contre, si tu integres la macro à un nouveau fichier, il te faut recréer le raccourci-clavier
L'adresse de la cellule cible (A1 devenu C3) doit bien sûr être modifiée dans la macro en cas de changement de configuration 

Cdlmnt

mijean94 · Answer

merci pour toutes les réponses


cordialement

mijean94 · Answer

Bonjour,

A l’utilisation de la fonction recentrage_zoom, dans mon fichier joint, j’ai un petit probléme : https://www.cjoint.com/c/FAju7VTssXt 

La fonction macro recentrage_zoom marche très bien si il n'y a pas de donnée dans la one en jaune, mais je souhaiterais que cette fonction soit réalisée même s’il y a des données dans les céllules en jaune, donc,

Que la zone verte, dans l’exemple joint, soit déplacée mais que la zone jaune reste toujours en place. 

Avez-vous une solution ?

cordialement

ccm81 · Answer

Bonjour

Essaies celle-ci

Public Sub Cale()Dim lideb As Long, codeb As Long, lifin As Long, cofin As Long, li As Long, co As LongDim plage As RangeWith ActiveSheet  lideb = .Range(celcible).Row  codeb = .Range(celcible).Column  lifin = Cells.Find("*", , , , xlByRows, xlPrevious).Row  cofin = Cells.Find("*", , , , xlByColumns, xlPrevious).Column  li = lideb - 1  Do    li = li + 1    co = .Cells(li, Columns.Count).End(xlToLeft).Column  Loop Until co > codeb  lideb = li  co = codeb - 1  Do    co = co + 1    li = .Cells(Rows.Count, co).End(xlUp).Row  Loop Until li > lideb  codeb = co  'MsgBox .Cells(lideb, codeb).Address  Set plage = .Range(.Cells(lideb, codeb), .Cells(lifin, cofin))  plage.Cut Destination:=Range(celcible)End WithEnd Sub
Cdlmnt

mijean94 · Answer

Bonjour à tous, 
Bonjour CCM81

Merci CCM81pour ta fonction qui marche très bien.
Je vais essayé d'y ajouter la fonction zoom sur la zone recentrée.

Cordialement

ccm81 · Answer

En principe, en ajoutant les 5 lignes avant End With, ça devrait fonctionner

  lifin = Cells.Find("*", , , , xlByRows, xlPrevious).Row  cofin = Cells.Find("*", , , , xlByColumns, xlPrevious).Column  Set plage = .Range(.Cells(1, 1), .Cells(lifin, cofin))  plage.Select  ActiveWindow.zoom = TrueEnd With
Bonne soirée

ccm81 · Answer

Re, re ...

Je crois qu'il y avait plus que ça, essaies celle là !
http://www.cjoint.com/c/FAlpgSY1I8I 

Cdlmnt

ccm81 · Answer

Re, re, re ...

Et surtout celle là nettement plus simple
http://www.cjoint.com/c/FAlp6FrNhuI 

Cdlmnt

mijean94 · Answer

Bonjour à tous,

bonjour ccm81 et merci pour les réponses.

La fonction zoom  prend toujours en compte des données de la zone jaune.
Ce que je souhaiterais, si possible, c'est de faire un zoom uniquement sur la zone recadrée donc la zone verte.

Cordialement

ccm81 · Answer

Comme ça ?

Option ExplicitConst celcible = "D3"Sub recentrage_zoom()Dim derlig As Long, dercol As Long, plage As RangeDim premlig As Long, premcol As Long, nbli As Long, nbco As Long' si pas assez grand comme taille, aaugmenter les nb de lignes et de colonnesSet plage = Range(celcible).Resize(1000, 100)' MsgBox plage.Addressderlig = plage.Find("*", , , , xlByRows, xlPrevious).Rowpremlig = plage.Find("*", , , , xlByRows, xlNext).Rowdercol = plage.Find("*", , , , xlByColumns, xlPrevious).Columnpremcol = plage.Find("*", , , , xlByColumns, xlNext).ColumnSet plage = Range(Cells(premlig, premcol), Cells(derlig, dercol))nbli = plage.Rows.Countnbco = plage.Columns.Countplage.Cut Destination:=Range(celcible)derlig = Range(celcible).Row + nbli - 1dercol = Range(celcible).Column + nbco - 1premlig = Cells.Find("*", , , , xlByRows, xlNext).Rowpremcol = Cells.Find("*", , , , xlByColumns, xlNext).ColumnSet plage = Range(Cells(premlig, premcol), Cells(derlig, dercol))plage.SelectActiveWindow.zoom = TrueRange(celcible).SelectEnd Sub
Cdlmnt

mijean94 · Answer

Re,

Merci encore  CCM81. 

Je viens de commander un livre sur la programmation en VBA, pour essayer de comprendre, mais ce n'est pas pour cela que j'y arriverais.

Je vais pendre une soirée de détente grâce  CCM81.   

Bonne soirée à tous.

Cordialement

ccm81 · Answer

De rien

En y réfléchissant encore un peu, une fin de code plus simple

plage.Cut Destination:=Range(celcible)derlig = Range(celcible).Row + nbli - 1dercol = Range(celcible).Column + nbco - 1Set plage = Range(Cells(1, 1), Cells(derlig, dercol))plage.SelectActiveWindow.zoom = TrueRange(celcible).SelectEnd Sub
Bonne soirée

Cdlmnt

mijean94 · Answer

Bonjour, 

Merci vraiment à ccm81 qui pas ces solutions m’a fait comprendre qu’il y avait plusieurs possibilités pour arriver à un résultat, et que le chemin pour y aboutir n’était pas toujours visible du premier coup, sans oublier que le plus difficile, pour aboutir à une solution, était de bien définir son besoin pour avoir de l’aide est là ce n’était pas toujours simple à transcrire par l’écriture. 
De plus en utilisant la fonction souhaitée on peut se rendre compte de ces erreurs d’explication dans la demande, mais grâce à la perspicacité des intervenants, donc de l’aide apporté par le forum, la solution serait ou bout du chemin. 

En plus de l’aide que tu m’as apporté, ccm81, tu m’as donné l’envie d’essayer de comprendre et de faire. Un grand merci à toi et à tous pour votre soutien sur l’avancement d’une application perso.

Comme le disait Aristote, c'est en construisant qu’on devient constructeur…

Merci à tous et à très bientôt pour de nouvelles aventures.

J’ai pris le temps de mettre en frome toutes les infos récoltées pour mon application + un peut de travail perso est voici le code final que j’utilise si cela peut-être utile pour quelqu’un :

-Recherche d’une zone de données
-recadrage de cette zone à une position définie
-zoom sur la zone
-Demande de validation oui ou non
-Si oui copie de la zone dans une autre feuille
-Si non, demande de faire les modifications souhaitées 


Sub visu_dessin() 
Const celcible = "D3"
Dim Rep As Integer
Dim derlig As Long, dercol As Long, plage As Range
Dim premlig As Long, premcol As Long, nbli As Long, nbco As Long
    Set plage = Range(celcible).Resize(1000, 100)
'selection et recentrage de la zone de travail
    derlig = plage.Find("*", , , , xlByRows, xlPrevious).Row
    premlig = plage.Find("*", , , , xlByRows, xlNext).Row
    dercol = plage.Find("*", , , , xlByColumns, xlPrevious).Column
    premcol = plage.Find("*", , , , xlByColumns, xlNext).Column
        Set plage = Range(Cells(premlig, premcol), Cells(derlig, dercol))
    nbli = plage.Rows.Count
    nbco = plage.Columns.Count
    plage.Cut Destination:=Range(celcible)
'zoom sur la zone de travail
    derlig = Range(celcible).Row + nbli - 1
    dercol = Range(celcible).Column + nbco - 1
        Set plage = Range(Cells(3, 4), Cells(derlig, dercol))
    plage.Select
     ActiveWindow.zoom = True
    Range(celcible).Select  
'fenetre de choix de la réponse oui ou non
    Rep = MsgBox("le dessin est-il conforme à votre attente ?", vbYesNo + vbQuestion, "VALIDATION DE LA CREATION")
    If Rep = vbYes Then
' traitement si la réponse est Oui
        derlig = Range(celcible).Row + nbli - 1
        dercol = Range(celcible).Column + nbco - 1
        Set plage = Range(Cells(3, 4), Cells(derlig, dercol))
        plage.Select
    plage.Copy
    Sheets("dessin").Select
    Range("D3").Select
    ActiveSheet.Paste
    Range("D3").Select
    Else 
' traitement si la réponse est non
        Dim SH As Object
    Set SH = CreateObject("WScript.Shell")
    SH.Popup "vous pouvez réaliser les modifications soauhaitées", 5, "5 secondes", 48
    Set SH = Nothing
    End If
End Sub

Cordialement

ccm81 · Answer

Une fois le code copié ici, tu selectionnes tout le code, puis tu as le choix entre l'icone <> (Code) à côté du S (en haut de cette fenêtre) et l'icone suivante (triangle) qui ajoute la coloration syntaxique propre à chaque langage (chez moi sous ie ne fonctionne pas).
RQ. Les autres icones permettent de mettre le texte en gras (G), italique (I), et souligné (S) et la dernière d'insérer une image

Bonne soirée

mijean94 · Answer

Re,

Ok merci

juste un essai pour voir si ça marche donc j'ai bien compris :

' traitement si la réponse est Oui        derlig = Range(celcible).Row + nbli - 1        dercol = Range(celcible).Column + nbco - 1        Set plage = Range(Cells(3, 4), Cells(derlig, dercol))        plage.Select       

cordialement

Recentrage automatique d'un tableau

23 réponses

Newsletters