Changer la macro

Caninge

XLDnaute Accro
Bonjour à Tous........

Je posséde cette macro aimablement suggérée il y a quelques

jours qui fonctionne bien mais que je veux modifier !!!

Je joins un petit fichier en espérant que vous allez me comprendre

Merci!!!!!


Private Sub Worksheet_Activate()
pression1 = False
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Intersect(Target, Range('B4,D4,F4,H4')) Is Nothing Then
pression1 = False
Exit Sub
End If

If pression1 = False Then
source1 = Target.Address(0, 0)
pression1 = True
Else
source2 = Target.Address(0, 0)
pression1 = False


'Nomazy-Village au Crédit Agricole
If source1 = 'B4' And source2 = 'D4' Or _
source1 = '' And source2 = '' Then
With Sheets('Reports')
Sheets('Route').Range('Plage1').Copy .Range('a' & .Range('a65536').End(xlUp).Row + 1)
MsgBox 'Transfert effectué', , 'Le parcours'
End With
End If

'Crédit Agricole à Chapeau
If source1 = 'D4' And source2 = 'F4' Or _
source1 = '' And source2 = '' Then
With Sheets('Reports')
Sheets('Route').Range('Plage1').Copy .Range('a' & .Range('a65536').End(xlUp).Row + 1)
MsgBox 'Transfert effectué', , 'Le parcours'
End With
End If

'Chapeau à Thiel
If source1 = 'F4' And source2 = 'H4' Or _
source1 = '' And source2 = '' Then
With Sheets('Reports')
Sheets('Route').Range('Plage1').Copy .Range('a' & .Range('a65536').End(xlUp).Row + 1)
MsgBox 'Transfert effectué', , 'Le parcours'
End With
End If [file name=NouvelleMAcro.zip size=2070]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/NouvelleMAcro.zip[/file]
 

Pièces jointes

  • NouvelleMAcro.zip
    2 KB · Affichages: 17

Hellboy

XLDnaute Accro
Bonjour Caninge

Est-ce que ceci répondrait a ta demande ?




Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
Dim bytColumn        As Byte
   
Dim intLineRef        As Integer
   
   
If Not Intersect(Target, Range('C4:IV4')) Is Nothing Then    '    Je me base que sur les clic de la ligne 4
           
With Target
                    bytColumn = .Column
               
'    J'emplois la logique que si on est sur une colonne IMPAIR on effectue un traitement
                   
If bytColumn Mod 2 Then
                            intLineRef = Cells(65532, bytColumn - 1).End(xlUp).Row
                   
'    Pas de copy paste, parce que une boucle infini s'engage
                            Range(Cells(4, bytColumn), Cells(intLineRef, bytColumn)).Value = _
                            Range(Cells(4, bytColumn - 1), Cells(intLineRef, bytColumn - 1)).Value
                   
End If
           
End With
   
End If
End Sub


En passant, cette procédure devrait remplacer tout le code qu'il y a dans ton message précédant !

Message édité par: Hellboy, à: 11/10/2005 20:49
 

Caninge

XLDnaute Accro
Bonjour Hellboy

On se retrouve.

Je préfère t'avouer franchement que je ne comprends pas du tout ton

travail.je pense comprendre en tout et pour tout peut-être 2 à 3 %

de VisualBasic.

C'est pour cela que j'ai refais mon fichier et si tu veux bien adapter ton code à mes feuilles.

Je pense que cela serait mieux.

Cela serait sympa de ta part

CANINGE

[file name=NouvelleMAcroV.zip size=7573]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/NouvelleMAcroV.zip[/file]
 

Pièces jointes

  • NouvelleMAcroV.zip
    7.4 KB · Affichages: 12

Hellboy

XLDnaute Accro
re Caninge

Je vois que tu as rajouté des cellules en rouge. C'est différents de la présentation du premier problèmes. La logique que j'y ai appliqué, ne fonctionne plus. C'est bien de précisé avant ce genre de détail.

Parlant de détail, avant de me relancer; dans l'examples de ton code, il semble que tu copie plusieurs cellules et c'est ce que j'ai repris, mais avec ton 2 ième example j'en doute maintenant.

Pourrais-tu précisé si ce que tu veux copier, n'est qu'une seule cellule ou plusieurs et si c'est constant et enfonction de quoi ?

Pourrais-tu préciser s.v.p. si les case vont être colorié, ou NON et quel couleur ?

Ton fichier original, serait un meilleur atout aussi !

A+
 

Caninge

XLDnaute Accro
Bonjour Hellboy

Oui je me suis peut-être mal expliqué.
En faite ce que je veux faire c'est établir un parcours avec les kilomètres et altitudes entre les villes.

Etablir un profil du parcours avec graphique etc...

Ce qui m'importe c'est de récupérer ces données

Il y a un arrière-plan dans la feuille Carte.
Cet arrière-plan est une carte routière.
La couleur des villes n'a pas d'importance.
Bleu, vert ou rouge tant pis.
Si les cellules sont colorées c'est simplement pour mieux les distinger.

Je t'envoie un nouvel exemple.

Je te remercie

CANINGE





[file name=NouvelleMAcroV3.zip size=8305]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/NouvelleMAcroV3.zip[/file]
 

Pièces jointes

  • NouvelleMAcroV3.zip
    8.1 KB · Affichages: 15

Caninge

XLDnaute Accro
Bonjour Hellboy

Oui je me suis peut-être mal expliqué.
En faite ce que je veux faire c'est établir un parcours avec les kilomètres et altitudes entre les villes.

Etablir un profil du parcours avec graphique etc...

Ce qui m'importe c'est de récupérer ces données

Il y a un arrière-plan dans la feuille Carte.
Cet arrière-plan est une carte routière.
La couleur des villes n'a pas d'importance.
Bleu, vert ou rouge tant pis.
Si les cellules sont colorées c'est simplement pour mieux les distinger.

Je t'envoie un nouvel exemple.

Je te remercie

CANINGE





[file name=NouvelleMAcroV3_20051012174217.zip size=8305]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/NouvelleMAcroV3_20051012174217.zip[/file]
 

Pièces jointes

  • NouvelleMAcroV3_20051012174217.zip
    8.1 KB · Affichages: 14

Hellboy

XLDnaute Accro
re Caninge et le Forum

Caninge, je crois que tu nous fait tourner en rond.

Ces fils te rappel-til quelque choses ?

Lien supprimé

Ou encore

Lien supprimé

Je vois ce que tu veux accomplir, mais je t'en pris si il y a déjà du travail de fait sur le même sujet ....

Alors, ce que je te demande, c'est d'abord de BIEN choisir le fichier que tu veux que l'on utilise pour t'aider a avancer.

Ce que tu as comme project, c'est pas facile je te comprend, mais si tu n'est pas très alaise en VBA, c'est encore une marche plus haute.

Je suis prèt a investir du temps pour t'aider, mais il va faloir que tu me donne un peu de temps s.v.p.

a+
 

Caninge

XLDnaute Accro
Rebonjour Hellboy

Oui je pense que je tourne un peu en rond mais il faut me comprendre parce que pour moi le VBA c'est quand même un mystère.

D'autant plus qu'il y a des mots en anglais et que je n'ai jamais parlé cette langue de ma vie.

C'est vrai que j'avais déja posé une question mais après coup et
dans le même ordre d' idée j'ai voulu modifier ma question.

je ne te demande pas une réponse immédiate.

tout le monde fait ce qu'il peut et je le comprends.

Allez au revoir et merci

CANINGE
 

Caninge

XLDnaute Accro
Rebonjour Hellboy

Oui je pense que je tourne un peu en rond mais il faut me comprendre parce que pour moi le VBA c'est quand même un mystère.

D'autant plus qu'il y a des mots en anglais et que je n'ai jamais parlé cette langue de ma vie.

C'est vrai que j'avais déja posé une question mais après coup et
dans le même ordre d' idée j'ai voulu modifier ma question.

je ne te demande pas une réponse immédiate.

tout le monde fait ce qu'il peut et je le comprends.

Allez au revoir et merci

CANINGE
 

Discussions similaires

Statistiques des forums

Discussions
312 329
Messages
2 087 329
Membres
103 517
dernier inscrit
hbenaoun63