Recentrage automatique d'un tableau

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

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

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

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 - 1
dercol = Range(celcible).Column + nbco - 1
Set plage = Range(Cells(1, 1), Cells(derlig, dercol))
plage.Select
ActiveWindow.zoom = True
Range(celcible).Select
End Sub

Bonne soirée

Cdlmnt

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

Comme ça ?

Option Explicit

Const celcible = "D3"

Sub recentrage_zoom()
Dim derlig As Long, dercol As Long, plage As Range
Dim 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 colonnes
Set plage = Range(celcible).Resize(1000, 100)
' MsgBox plage.Address
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)
derlig = Range(celcible).Row + nbli - 1
dercol = Range(celcible).Column + nbco - 1
premlig = Cells.Find("*", , , , xlByRows, xlNext).Row
premcol = Cells.Find("*", , , , xlByColumns, xlNext).Column
Set plage = Range(Cells(premlig, premcol), Cells(derlig, dercol))
plage.Select
ActiveWindow.zoom = True
Range(celcible).Select
End Sub

Cdlmnt

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

Re, re, re ...

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

Cdlmnt

Re, re ...

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

Cdlmnt

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 = True
End With

Bonne soirée

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

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 Long
Dim plage As Range
With 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 With
End Sub

Cdlmnt

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

merci pour toutes les réponses

cordialement

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

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

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

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

Essaies ceci

Const celcible = "A1"

Sub recentrage()
Dim derlig As Long, dercol As Long, plage As Range
Dim premlig As Long, premcol As Long
derlig = Cells.Find("*", , , , xlByRows, xlPrevious).Row
premlig = Cells.Find("*", , , , xlByRows, xlNext).Row
dercol = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
premcol = Cells.Find("*", , , , xlByColumns, xlNext).Column
Set plage = Range(Cells(premlig, premcol), Cells(derlig, dercol))
plage.Cut Destination:=Range(celcible)
End Sub

Cdlmnt

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

Cordialement