Macro écrire autour d'une plage

Le 05/07/2019 à 17:30

Bonjour les excelpraticiens,

bonjour excelpraticiennes,

bonjour les autres

aujourd'hui je suis à la recherche d'une macro permettant d'écrire dans 4 cellules autour d'un tableau.

Sur une première page, j'ai créé une plage de cellules, disons ceci (c'est un exemple, la taille et les adresses ne seront pas toujours les mêmes) :

t1b10

Je copie le tableau Range("C9:L25"), et je le colle sur une autre feuille, un peu n'importe où, par exemple en E4, je dis ça au hasard.

t210

C'est maintenant que je veux écrire une apostrophe dans les coins extérieurs relatifs à cette plage, soit D3, D21, O3 et O21. Le curseur devra se positionner ensuite dans la cellule E4

Et là, je ne sais pas faire la macro, pouvez-vous m'aider?

J'ai fait une macro enregistrée, mais je ne sais pas l'appliquer à des plages de taille différentes, et/ou placées à d'autres endroits.

Ci-joint AposeApostrophe

5aposeapostrophe.xls (18.00 Ko)
Le 05/07/2019 à 17:33

Bonjour Patapin,

Tu as toujours des demandes originales ...

Je vais creuser ... mais dis-moi ... je suis curieux ... à quoi est-ce relié ???

Et ... où se trouve la macro que tu as déjà élaborée ...???

car l'opération que tu demandes ... dépend directement de ta macro de copie ...

Le 06/07/2019 à 10:30

Hello James !

Comment va?

Pour la macro, je croyais qu'elle était intégrée. Je ne sais pas trop comment faire.

Comment puis-je l'envoyer avec le fichier excel ?

Argh ! Elle a disparu !!! 'comprends pas... Je vais la refaire.

C'est fait :

Sub Aposetrof()
'
' Aposetrof Macro
' Macro enregistrée le 06/07/2019 par utilisateur
'

'
    ActiveCell.Offset(-1, -1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "'"
    ActiveCell.Offset(0, 11).Range("A1").Select
    ActiveCell.FormulaR1C1 = "'"
    ActiveCell.Offset(18, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "'"
    ActiveCell.Offset(0, -11).Range("A1").Select
    ActiveCell.FormulaR1C1 = "'"
    ActiveCell.Offset(-17, 1).Range("A1").Select
End Sub
Le 06/07/2019 à 10:37

Hello,

Je me suis sans doute mal exprimé ...

Il ne s'agit pas de la macro qui effectue l'ajout des Apostrophes ...

Mais de la macro précéente ... celle qui Copie la plage Source vers la Plage Destination ...

A titre illustratif ... sur la base de ton fichier test ...

Sub AposCopie()
Dim rngS As Range
Dim rngD As Range

Set rngS = Sheet1.Range("D12:K23")
Set rngD = Sheet2.Range("D12")

rngS.Copy Destination:=rngD

rngD(1, 1).Offset(-4, -2).Value = "'"
rngD(1, 1).Offset(-4, rngS.Columns.Count + 1).Value = "'"

rngD(1, 1).Offset(rngS.Rows.Count + 2, -2).Value = "'"
rngD(1, 1).Offset(rngS.Rows.Count + 2, rngS.Columns.Count + 1).Value = "'"

Application.Goto rngD(1, 1).Offset(-4, -2)

End Sub

En espèrant que cela t'aide

P.S. Tu évites soigneusement de répondre à ma question ...

A quoi cette requête est-elle liée ...???

Le 06/07/2019 à 12:15

Ah, super, merci James. On progresse, mais hélas, ta macro n'est valable que pour la plage de cellules en cours. J'aurais aimé l'adapter à toutes plages, de toutes les dimensions.

Je n'évite pas, j'oublie !

A quoi est-ce relié ? C'est pour m'aider à créer des jeux de ce style : https://forum.excel-pratique.com/viewtopic.php?f=9&t=119939

Où est la macro Copieuse ? Il n'y en a pas, j'ai copié "à la main" la plage de cellules.

J'avais pensé à cette astuce : la copier, puis la coller sur une autre feuille (ou la même d'ailleurs, maintenant que j'y pense, l'idiot que je suis), et à cet instant, toute la plage est surlignée, comme sur l'image numéro . Du coup, peut-être qu'on peut "capter" les coordonnées de cette plage ?

Bon appétit, et à demain ! (je déconnecte)

Le 06/07/2019 à 13:19

Re,

Merci pour l'explication des jeux ...

Pour rendre la macro proposée .. il suffit de rendre dynamiques les deux plages : la plage Source et la plage Destination ...

Ton problème serait-il ainsi réglé ...?

A tester la macro en Version 2 ...

Sub AposCopie2()
Dim rngS As Range
Dim rngD As Range

 On Error Resume Next
    Set rngS = Application.InputBox( _
      Title:="Plage Source", _
      Prompt:="Merci de saisir la plage Source", _
      Type:=8)

    Set rngD = Application.InputBox( _
      Title:="Plage Destination", _
      Prompt:="Merci de saisir la cellule Destination", _
      Type:=8)
  On Error GoTo 0

rngS.Copy Destination:=rngD

rngD(1, 1).Offset(-4, -2).Value = "'"
rngD(1, 1).Offset(-4, rngS.Columns.Count + 1).Value = "'"

rngD(1, 1).Offset(rngS.Rows.Count + 2, -2).Value = "'"
rngD(1, 1).Offset(rngS.Rows.Count + 2, rngS.Columns.Count + 1).Value = "'"

Application.Goto rngD(1, 1).Offset(-4, -2)

End Sub
Le 07/07/2019 à 12:07

Hello, de retour parmi les gens éveillés, qui pensent et qui réfléchissent la lumière de leurs connaissances sur les vers de terre et autres vermiceaux comme moi....

Belle tentative James, très habile !

En effet ça simplifie encore le travail.

Si j'ai bien compris (et oui, puisque j'ai expérimenté), je lance ta macro2, je surligne ma plage à copier, je fais OK, je sélectionne la cellule de destination, OK pour coller la plage, et hop, 4 apostrophes sont créeés.

De ce point de vue, ça marche parfaitement, bravo à toi.

Il y a juste un détail à régler, c'est que les apostrophes n'arrivent pas exactement dans les coins de la place choisies.

En effet, la plage de cellules d'exemple ne démarre pas avec le contenu B1 (situé en cellule F7) pour aller jusqu'à la cellule M18, non.

Je prends en considération la plage D4:N20

Du coup, tes apostrophes sont décalées de quelques lignes et colonnes (j'ai colorées en rouge les cellules où ta macro écrit les apostrophes) :

Et j'aimerais plutôt qu'elles atterrissent dans les cases vertes :

Je me suis donc permis de modifier la macro ainsi :

Sub AposCopie3()

Dim rngS As Range

Dim rngD As Range

On Error Resume Next

Set rngS = Application.InputBox( _

Title:="Plage Source", _

Prompt:="Merci de saisir la plage Source", _

Type:=8)

Set rngD = Application.InputBox( _

Title:="Plage Destination", _

Prompt:="Merci de saisir la cellule Destination", _

Type:=8)

On Error GoTo 0

rngS.Copy Destination:=rngD

rngD(1, 1).Offset(-1, -1).Value = "'"

rngD(1, 1).Offset(-1, rngS.Columns.Count + 1).Value = "'"

rngD(1, 1).Offset(rngS.Rows.Count + 1, -1).Value = "'"

rngD(1, 1).Offset(rngS.Rows.Count + 1, rngS.Columns.Count + 1).Value = "'"

Application.Goto rngD(1, 1).Offset(-1, -1)

End Sub

Et ça a l'air d emarcher !

Merci James

apos3 aposc2
Le 07/07/2019 à 12:22

Ah non, ça ne marche pas tout à fait, je me suis trompé

Le 07/07/2019 à 13:25

Re,

Si tu as compris la logique de Offset() ... tu peux sans doute adapter la macro à tes besoins ...

Sinon .. dire que " çà ne marche pas ..." ne fait pas du tout progresser le sujet ...

Par contre, joindre un fichier test ....illustratif ... devient redoutablement efficace ...

Le 07/07/2019 à 14:33
James007 a écrit :

Sinon .. dire que " çà ne marche pas ..." ne fait pas du tout progresser le sujet ...

Oups !

Disons que je n'avais fait qu'un essai non concluant.

Depuis, j'ai testé, retesté et détesté ma version, et voici les résultats, tous identiques :

1. l'apostrophe en haut à gauche est bien positionnée

2. l'apostrophe haut/droite est sur la bonne ligne, mais décalée d'une cellule à droite

3. l'apostrophe bas/droite est décalée à la fois d'une ligne vers le bas et d'une colonne vers la droite

4. enfin l'apostrophe bas/gauche est sur la bonne colonne, mais décalée d'une ligne vers le bas

Volà, j'ai trouvé !

Voir le message suivant.

Le 07/07/2019 à 14:41

J'ai trouvé !

Sub Aposcopi4()
'
' Aposcopi4 Macro
' Macro enregistrée le 07/07/2019 par utilisateur
'
Dim rngS As Range
Dim rngD As Range

 On Error Resume Next
    Set rngS = Application.InputBox( _
      Title:="Plage Source", _
      Prompt:="Merci de saisir la plage Source", _
      Type:=8)

    Set rngD = Application.InputBox( _
      Title:="Plage Destination", _
      Prompt:="Merci de saisir la cellule Destination", _
      Type:=8)
  On Error GoTo 0

rngS.Copy Destination:=rngD

rngD(1, 1).Offset(-1, -1).Value = "'"
rngD(1, 0).Offset(-1, rngS.Columns.Count + 1).Value = "'"

rngD(0, 1).Offset(rngS.Rows.Count + 1, -1).Value = "'"
rngD(0, 0).Offset(rngS.Rows.Count + 1, rngS.Columns.Count + 1).Value = "'"

Application.Goto rngD(1, 1).Offset(-1, -1)

End Sub

Merci pour ton aide précieuse, James !

Le 07/07/2019 à 14:53

Ravi que tout fonctionne ...

Merci pour tes remerciements ...

Le 07/07/2019 à 16:45

Bonjour James et Patapin,

sympa votre sujet, j'ai vraiment cru que vous étiez à la plage à discuter autour de votre serviette et de son déplacement

j'étais prêt à répondre d'utiliser une tablette quand je me suis rendu compte qu'il s'agissait d'un jeu.

Restez pas trop longtemps au soleil

a+

fronck

Le 08/07/2019 à 08:52

Les prisonniers du boulot s'occupent des cellules, et les vacanciers s'occupent des plages !

A plus, James et fronck

PS : et si on améliorait un peu la présentation d el aplage de cellules ?

J'ouvre un autre sujet, allez !

Le 08/07/2019 à 08:55

Bonjour,

Grâce à toi .. j'ai appris que la confection de la pâte à pain est en fait un exercice très subtil de différents dosages

Rechercher des sujets similaires à "macro ecrire autour plage"