> Tous les forums > Forum Bureautique
 transmission de variable d'une sub vers une autreSujet résolu
Ajouter un message à la discussion
Page : [1] 
Page 1 sur 1
rogerone
  Posté le 31/10/2011 @ 18:58 
Aller en bas de la page 
Petit astucien

Bonsoir,

Je travaille avec windows XP et Excel 3.

J'ai établi une macro en VBA qui

CHERCHE DANS UN FICHIER EXCEL le nom d'une équipe (simplement de "A à U") dont je connais le N° de ligne et de colonne.

ce numéro (i un integer) me permetta de trouver le nom des joueurs (4 joueurs) et leur classement qui se trouve sur la même ligne mais dans des colonnes différentesrenseignements que je transmettrai dans un fichier de 12 feuilles.

Dans une de ces feuilles je place deux équipes dans un tableau une à droite et l'autre à gauche (d(où impaire ou paire)

Les équipes A ET B seront placées dans une feuille dénommée "A-B" C ET D dans une autre feuille dénommée C-D ETC.

le problème est que j'ai une erreur me disant que PAIRE et Impaire ne sont pas définies.ET je ne vois pas comment faire.

La simplicité voudrait que pour chaque équipe je reprenne les instructions de paire ou impaire pour chaque équipe.Vous voyez la longueur du code.C'est pourquoi j'utilise un select case et alors en fonction que l'équipe doit se placer à droite ouà gauche j'aurais voulu utiliser les sub droite ou gauche mais un autre problème la valeur de i est-elle transmise ?

voiciun extrait de mon code

Public i As Integer

Sub macro3()

' Macro3 Macro
' Macro enregistrée le 29/10/2011 par user


Dim eq As String


Workbooks.Open Filename:="E:\tennis\NOMEQUIPES.xls"

'fichiers avec 12 feuilles (A-B....CD...
Workbooks.Open Filename:="E:\TENNIS\FEMA.xls"

fichier contenat les renseignements à transférer


i = 0

OU = "A DOMICILE"
eq = "A"
While eq > ""


i = i + 1
Windows("FEMA.xls").Activate

Cells(i, 8).Select
eq = Cells(i, 8).Value
x = Asc(eq)
Windows("NOMEQUIPES.xls").Activate
Select Case eq
Case "A"

Sheets("A-B").Select
Range("A2").Select
Range("A2").Value = OU
On x Mod 2 = 0 GoSub IMPAIRE, PAIRE


Case "B"


Windows("NOMEQUIPES.xls").Activate

Sheets("A-B").Select
Range("d2").Select
Range("d2").Value = OU
If x Mod 2 = 0 Then GoTo IMPAIRE
If x Mod 2 = 1 Then GoTo PAIRE


End

etc

select end

i=i+1

wend

endsub

Sub PAIRE()


' Workbooks.Open Filename:="E:\tennis\NOMEQUIPES.xls"
'Workbooks.Open Filename:="E:\TENNIS\FEMA.xls"


Windows("FEMA.xls").Activate
Cells(i, 12).Select
Application.CutCopyMode = False
Selection.Copy
Windows("NOMEQUIPES.xls").Activate

Range("a3").Select
ActiveSheet.Paste
Windows("FEMA.xls").Activate
Cells(i, 13).Select
Application.CutCopyMode = False
Selection.Copy
Windows("NOMEQUIPES.xls").Activate
Range("b3").Select
ActiveSheet.Paste

Windows("FEMA.xls").Activate
Cells(i, 15).Select
Application.CutCopyMode = False
Selection.Copy
Windows("NOMEQUIPES.xls").Activate
Range("a4").Select
ActiveSheet.Paste

Windows("FEMA.xls").Activate
Cells(i, 16).Select
Application.CutCopyMode = False
Selection.Copy
Windows("nomequipes.xls").Activate
Range("b4").Select
ActiveSheet.Paste


Windows("FEMA.xls").Activate
Cells(i, 18).Select
Application.CutCopyMode = False
Selection.Copy
Windows("NOMEQUIPES.xls").Activate
Range("a5").Select
ActiveSheet.Paste
Windows("FEMA.xls").Activate
Cells(i, 19).Select
Application.CutCopyMode = False
Selection.Copy
Windows("NOMEQUIPES.xls").Activate
Range("b5").Select
ActiveSheet.Paste


Windows("FEMA.xls").Activate
Cells(i, 21).Select
Application.CutCopyMode = False
Selection.Copy
Windows("NOMEQUIPES.xls").Activate
Range("a6").Select
ActiveSheet.Paste


Windows("FEMA.xls").Activate
Cells(i, 22).Select
Application.CutCopyMode = False
Selection.Copy
Windows("NOMEQUIPES.xls").Activate
Range("b6").Select
ActiveSheet.Paste

End Sub



Sub IMPAIRE()
'Workbooks.Open Filename:="E:\tennis\NOMEQUIPES.xls"
'Workbooks.Open Filename:="E:\TENNIS\FEMA.xls"


Windows("FEMA.xls").Activate
Cells(i, 12).Select
Application.CutCopyMode = False
Selection.Copy
Windows("NOMEQUIPES.xls").Activate
Range("d3").Select
ActiveSheet.Paste
Windows("FEMA.xls").Activate
Cells(i, 13).Select
Application.CutCopyMode = False
Selection.Copy
Windows("NOMEQUIPES.xls").Activate
Range("e3").Select
ActiveSheet.Paste

Windows("FEMA.xls").Activate
Cells(i, 15).Select
Application.CutCopyMode = False
Selection.Copy
Windows("NOMEQUIPES.xls").Activate
Range("d4").Select
ActiveSheet.Paste
Windows("FEMA.xls").Activate
Cells(i, 16).Select
Application.CutCopyMode = False
Selection.Copy
Windows("nomequipes.xls").Activate
Range("e4").Select
ActiveSheet.Paste

Windows("FEMA.xls").Activate
Cells(i, 18).Select
Application.CutCopyMode = False
Selection.Copy
Windows("NOMEQUIPES.xls").Activate
Range("d5").Select
ActiveSheet.Paste
Windows("FEMA.xls").Activate
Cells(i, 19).Select
Application.CutCopyMode = False
Selection.Copy
Windows("NOMEQUIPES.xls").Activate
Range("e5").Select
ActiveSheet.Paste


Windows("FEMA.xls").Activate
Cells(i, 21).Select
Application.CutCopyMode = False
Selection.Copy
Windows("NOMEQUIPES.xls").Activate
Range("d6").Select
ActiveSheet.Paste
Windows("FEMA.xls").Activate
Cells(i, 22).Select
Application.CutCopyMode = False
Selection.Copy
Windows("NOMEQUIPES.xls").Activate
Range("e6").Select
ActiveSheet.Paste

End Sub

C'est difficile à expliquer .j'ai fait de mon mieux.

J'espère que vous m'aiderez

rogerone

Publicité
Mytå
 Posté le 31/10/2011 à 19:36 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

Salut le forum

Remplace

On x Mod 2 = 0 GoSub IMPAIRE, PAIRE

Par

IF x Mod 2 = 0 Then

Call IMPAIRE

Else

Call PAIRE

End if

Mytå

Mytå
 Posté le 01/11/2011 à 01:33 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

Re le forum

Recu en messagerie privé

Un tout grand merci.C'est bien la première fois que j'obtiens une réponse aussi rapide.

Je pense que cela ira J'ai des résultats prbants.Quelques améliorations à mon proramme et le tour est joué

Merci encore

Rogerone


Mytå



Modifié par Mytå le 01/11/2011 01:35
Page : [1] 
Page 1 sur 1

Vous devez être connecté pour participer à la discussion.
Cliquez ici pour vous identifier.

Vous n'avez pas de compte ? Créez-en un gratuitement !
Recevoir PC Astuces par e-mail


La Lettre quotidienne +226 000 inscrits
Avec l'actu, des logiciels, des applis, des astuces, des bons plans, ...

Les bonnes affaires
Une fois par semaine, un récap des meilleurs offres.

Les fonds d'écran
De jolies photos pour personnaliser votre bureau. Une fois par semaine.

Les nouveaux Bons Plans
Des notifications pour ne pas rater les bons plans publiés sur le site.

Les bons plans du moment PC Astuces

Tous les Bons Plans
35,95 €Compresseur portable autonome Xiaomi Mija à 35,95 €
Valable jusqu'au 30 Juillet

Amazon fait une promotion sur le compresseur portable autonome Xiaomi Mija qui passe à 35,95 € livré gratuitement. Ce compresseur à emporter facilement avec vous comporte un écran (où vous pourrez choisir la pression à atteindre en PSI ou BAR) une batterie de 2000 mA et vous permettra de gonfler vos jouets (41 pièces avec une charge), pneus de vélo, de trotinette, de moto (6 pneus avec une charge) et même de voiture (5 pneus avec une charge) facilement.

Le câble est accompagné d'un embout pour valve Schrader et un adapteur Presta et une aiguille sont fournis. Le compresseur se recharge via une prise Micro USB.


> Voir l'offre
749,99 €Ultra portable Asus Zenbook UX325JA (Core i5, FullHD OLED, 8 Go, SSD 512 Go) à 749,99 €
Valable jusqu'au 31 Juillet

Fnac fait une promotion sur l'ordinateur portable Asus Zenbook UX325JA-2 qui passe à 749,99 € livré gratuitement. Cet ultra portable dispose d'une dalle Full HD (1920x1080) OLED de 13,3 pouces, d'un processeur Intel Core i5-1035G4, de 8 Go de RAM, d'un SSD de 512 Go et ne pèse que 1,1 kg. Le tout tourne sous Windows 10 et offre une autonomie réelle de 7 à 8 heures. Les traditionnels WiFi, Bluetooth, lecteur de carte mémoire et Webcam HD sont de la partie.


> Voir l'offre
164,99 €Ecran PC 24 pouces Samsung Odyssey G3 (FHD, 144 Hz, 1 ms) à 164,99 €
Valable jusqu'au 30 Juillet

Cdiscount fait une promotion sur l'écran PC Samsung 24 pouces Samsung Odyssey G3 à 164,99 € avec le code promo 15EUROS. Cet écran de 24 pouces offre une définition FHD de 1920x1080 pixels et est compatible FreeSync Premium avec un taux de réponse de 1 ms et un rafraichissement de 144 Hz. Connectiques HDMI, VGA et DP.


> Voir l'offre

Sujets relatifs
TRANSFERT D'UNE VARIABLE VERS UNE AUTRE SUB
Copier plage de celules vers autre feuille sous condition
Copier tableaux vers autre feuille sous condition
Macro Copier ligne vers un autre fichier
colonne avec choix déroulant qui va vers une autre colonne choix déroulant
excel vba passer une variable de commande vers macro
transfert d'une cellule vers une autre
copier un dd externe vers un autre dd externe
Transférer donnée excel vers un autre fichier exce
Lien hypertexte vers autre fichier ppt et retour
Plus de sujets relatifs à transmission de variable d''une sub vers une autre
 > Tous les forums > Forum Bureautique