Fermeture d'un userform a partir d'un autre userform

Version imprimable

19/12/2010, 16h12
VELO1222

Fermeture d'un userform a partir d'un autre userform
Bonjour le forum,
je vous pose mon problème
A partir d'un fichier A et d'un userform j'ouvre un autre fichier B qui contient lui aussi un userform a son ouverture.
- je copy des données du fichier A vers le fichier B
- puis a la fin du copier coller je n'arrive pas a fermer le fichier B
la userform du fichier B reste a l'écran impossible de la fermer si vous pouviez m'aider d'avance merci
19/12/2010, 17h46
pgz
Bonsoir.

Il ne serait pas inutile que tu montres :
- le code de A qui ouvre B
- Le code de B qui ouvre l'userform
- le code de A qui ferme B.
Cordialement,

PGZ

Bonsoir,
pas de probleme

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Private Sub CommandButton5_Click()
 
i = MsgBox("        Vous confirmez la création du NOUVEAU TARIFAIRE                 " & vbCr & "        Sans avoir oublié de remplir les renseignements de la 1ère étape ?                " & vbCr & " " & vbCr & "                - Le Mois et l'année du Nouveau Tarifaire " & vbCr & "                - Le Taux de Marge Budgeté du mois a venir ", vbYesNo + vbQuestion, "Renseignements")
If i = vbYes Then
Application.ScreenUpdating = False
 
Sheets("COEFFICIENTS").Select
T = Range("E54")
R = Range("D62")
Workbooks.Open Filename:=Range("D61")
 
Application.Windows(R).Activate
Sheets("COEFFICIENTS").Range("D49").Copy
Application.Windows(T).Activate
Sheets("PARAMETRAGE").Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.Windows(T).Activate
    Application.CutCopyMode = False
 
Application.Windows(R).Activate
Sheets("COEFFICIENTS").Range("D48").Copy
Application.Windows(T).Activate
Sheets("PARAMETRAGE").Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.Windows(T).Activate
    Application.CutCopyMode = False
 
Application.Windows(R).Activate
Sheets("TARIF V BOVINE").Range("E6:M52").Copy
Application.Windows(T).Activate
Sheets("VIANDE BOVINE").Activate
Range("E6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.Windows(T).Activate
    Application.CutCopyMode = False
 
ActiveWorkbook.Save
ActiveWindow.Close
 
 
 
 
Application.ScreenUpdating = True
End If
 
End Sub

l'userform du fichier B s'ouvre en Workbook_Open

Cdt

19/12/2010, 19h03
pgz

Bonsoir.

Mais on ne voit pas si B ouvre son formulaire en mode modal...
Tu peux essayer ceci : avant d'ouvrir B

Code:

Application.EnableEvents = false

Tu devras ensuite rétablir

Code:

Application.EnableEvents = true

Par ailleurs, tu devrais chercher comment on fait des copies sans activation des feuilles concernées. Voir par exemple cette discussion du jour
Tu seras agréablement surpris par la rapidité de "l'autre méthode".

Cordialement,

PGZ

heu

bonjour je suis assez daccors avec pgz tu n'est pas obligé de activer et desactiver a tout bout de champ

tiens voila la macro qui trans fert les données d'un devis sur la feuille matrice de mon application facturier tu constatera qu'il n'ya aucun activate ni de select ect..... sauf a la fin pour revenir au sheets souhaité car il y en a plusieur dans mon application c'est plus propre ,rapide,

tu n'a plus qu'a adapter a ton besoins
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Sub TransfertDevis() Application.DisplayAlerts = False Application.ScreenUpdating = False Dim titre As String Dim Wbk As Workbook titre = ThisWorkbook.Path & "\DEVIS\" & ThisWorkbook.Sheets("entree").LISTEDEVIS1.Value 'chemin et nom du fichier Set Wbk = Workbooks.Open(titre) ' jouvre le classeur (titre2) ThisWorkbook.Sheets("DEVIS").Range("f2").Value = Wbk.Sheets("DEVIS1").Range("f2").Value ThisWorkbook.Sheets("DEVIS").Range("g4:h11").Value = Wbk.Sheets("DEVIS1").Range("g4:h11").Value ThisWorkbook.Sheets("DEVIS").Range("b11").Value = Wbk.Sheets("DEVIS1").Range("b11").Value ThisWorkbook.Sheets("DEVIS").Range("a15:h40").Value = Wbk.Sheets("DEVIS1").Range("a15:h40").Value Wbk.Close ' fermeture du devis ou je récupère les données Application.DisplayAlerts = True Sheets("DEVIS").Activate Sheets("entree").LISTEDEVIS1.Clear End Sub
au plaisir

bonsoir,
je viens d'essayer avec ta proposition PGZ mais voila j'ai beug a se niveau

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Private Sub CommandButton5_Click()

i = MsgBox("        Vous confirmez la création du NOUVEAU TARIFAIRE                 " & vbCr & "        Sans avoir oublié de remplir les renseignements de la 1ère étape ?                " & vbCr & " " & vbCr & "                - Le Mois et l'année du Nouveau Tarifaire " & vbCr & "                - Le Taux de Marge Budgeté du mois a venir ", vbYesNo + vbQuestion, "Renseignements")
If i = vbYes Then

Application.ScreenUpdating = False
Application.EnableEvents = False

Sheets("COEFFICIENTS").Select
T = Range("E54")
R = Range("D62")
Workbooks.Open Filename:=Range("D61")

Application.Windows(R).Activate
Sheets("COEFFICIENTS").Range("D49").Copy
Application.Windows(T).Activate
Sheets("PARAMETRAGE").Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.Windows(T).Activate
    Application.CutCopyMode = False
    
Application.Windows(R).Activate
Sheets("COEFFICIENTS").Range("D48").Copy
Application.Windows(T).Activate
Sheets("PARAMETRAGE").Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.Windows(T).Activate
    Application.CutCopyMode = False
    
Application.Windows(R).Activate
Sheets("TARIF V BOVINE").Range("E6:M52").Copy
Application.Windows(T).Activate
Sheets("VIANDE BOVINE").Activate
Range("E6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.Windows(T).Activate
    Application.CutCopyMode = False
    
ActiveWorkbook.Save
ActiveWindow.Close




Application.ScreenUpdating = True

Application.EnableEvents = True
End If
End Sub

cdt

rebonjour

sans doute que ta variable "T" n'est pas instruite correctement cela dis fait un test avec ma proposition et dis moi ce que tu en pense en adaptant les variables et les celules a ton cas bien sur

EDIT:
tien voila un resumé de ton usine a gas

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
 
Sub copie()
Dim titre As String
Dim Wbk As Workbook
 
i = MsgBox("        Vous confirmez la création du NOUVEAU TARIFAIRE                 " & vbCr & "        Sans avoir oublié de remplir les renseignements de la 1ère étape ?                " & vbCr & " " & vbCr & "                - Le Mois et l'année du Nouveau Tarifaire " & vbCr & "                - Le Taux de Marge Budgeté du mois a venir ", vbYesNo + vbQuestion, "Renseignements")
If i = vbYes Then
 
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
 
Sheets("COEFFICIENTS").Select
T = Range("E54")  'ici je supose que les celule ont le nom des classeur en question
R = Range("D62")  'ici je supose que les celule ont le nom des classeur en question
 
Set Wbk = Workbooks.Open(R) ' jouvre le classeur (R)R etant instruit par la celule d62 si j'ai bien compris
 
ThisWorkbook.Sheets("PARAMETRAGE").Range("a2").Value = Wbk.Sheets("COEFFICIENTS").Range("D49").Value
ThisWorkbook.Sheets("PARAMETRAGE").Range("b2").Value = Wbk.Sheets("COEFFICIENTS").Range("D48").Value
ThisWorkbook.Sheets("VIANDE BOVINE").Range("E6:M52").Value = Wbk.Sheets("TARIF V BOVINE").Range("E6:M52").Value
Wbk.Close 
 
ActiveWorkbook.Save
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
End Sub

au plaisir

bonsoir patrick,
j'ai essayé aussi votre proposition et je bloque ici

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Private Sub CommandButton5_Click()

Dim titre As String
Dim Wbk As Workbook
 
i = MsgBox("        Vous confirmez la création du NOUVEAU TARIFAIRE                 " & vbCr & "        Sans avoir oublié de remplir les renseignements de la 1ère étape ?                " & vbCr & " " & vbCr & "                - Le Mois et l'année du Nouveau Tarifaire " & vbCr & "                - Le Taux de Marge Budgeté du mois a venir ", vbYesNo + vbQuestion, "Renseignements")
If i = vbYes Then
 
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
 
Sheets("COEFFICIENTS").Select
T = Range("E54")  'ici le nom des classeur en question
R = Range("D62")  'ici le nom des classeur en question
Y = Range("D61")  'ici le chemin pour ouvrir le fichier
Set Wbk = Workbooks.Open(Y) ' jouvre le classeur (R)R etant instruit par la celule d62 si j'ai bien compris
 
ThisWorkbook.Sheets("PARAMETRAGE").Range("a2").Value = Wbk.Sheets("COEFFICIENTS").Range("D49").ValueThisWorkbook.Sheets("PARAMETRAGE").Range("b2").Value = Wbk.Sheets("COEFFICIENTS").Range("D48").Value
ThisWorkbook.Sheets("VIANDE BOVINE").Range("E6:M52").Value = Wbk.Sheets("TARIF V BOVINE").Range("E6:M52").Value
Wbk.Close
 
ActiveWorkbook.Save
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
End Sub

pourquoi !!
J'ai donc inversé la programmation quand je lance ca travail mais rien ne se copy

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Private Sub CommandButton5_Click()
 
Dim titre As String
Dim Wbk As Workbook
 
i = MsgBox("        Vous confirmez la création du NOUVEAU TARIFAIRE                 " & vbCr & "        Sans avoir oublié de remplir les renseignements de la 1ère étape ?                " & vbCr & " " & vbCr & "                - Le Mois et l'année du Nouveau Tarifaire " & vbCr & "                - Le Taux de Marge Budgeté du mois a venir ", vbYesNo + vbQuestion, "Renseignements")
If i = vbYes Then
 
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
 
Sheets("COEFFICIENTS").Select
T = Range("E54")  'ici le nom des classeur en question
R = Range("D62")  'ici le nom des classeur en question
Y = Range("D61")  'ici le chemin pour ouvrir le fichier
Set Wbk = Workbooks.Open(Y) ' jouvre le classeur (R)R etant instruit par la celule d61 si j'ai bien compris
 
ThisWorkbook.Sheets("COEFFICIENTS").Range("D49").Value = Wbk.Sheets("PARAMETRAGE").Range("A2").Value
ThisWorkbook.Sheets("COEFFICIENTS").Range("D48").Value = Wbk.Sheets("PARAMETRAGE").Range("B2").Value
ThisWorkbook.Sheets("TARIF V BOVINE").Range("E6:M52").Value = Wbk.Sheets("VIANDE BOVINE").Range("E6:M52").Value
Wbk.Save
Wbk.Close
 
'ActiveWorkbook.Save
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub

d'avance merci de votre aide
Cdt
Tony

19/12/2010, 22h20
patricktoulon

re

ok
reprenons

dis moi le nom du classuer portant la macro et le sheets de destination

le nom du classuer ou tu va chercher les données avec le non du sheet
a la fin tu en ferme un le quel?

donne moi ces detail le plus precis possible et je te refet le macro
donne moi aussi le nom de l'userform qui doit etre arrété et dans quel classeur il est je vais essayer un truc

au plaisir
19/12/2010, 22h51
VELO1222

Re bonsoir Patrick,
le nom du fichier ou je lance la macro TARIFAIRE v5.xlm
la Userform ou je lance le programme se nomme Userform1
les sheets du fichier "COEFFICIENTS" et "TARIF V BOVINE"

le fichier que je souhaite ouvrir et y coller les info est le TARIF BOUCHERIE.xls
la Userform du fichier TARIF BOUCHERIE.xls qui s'ouvre en Workbook_Open se nomme TONY
les sheets du fichier A "PARAMETRAGE" et "VIANDE BOVINE"

donc a partir du TARIFAIRE v5 j'ouvre le fichier TARIF BOUCHERIE y colle des info provenant du TARIFAIRE
enregistre le collage du TARIF BOUCHERIE et le ferme

et je me retrouve toujours sur mon fichier TARIFAIRE v5 ouvert avec la Userform1 d'ou je lance ma macro

Cdt
Tony

Bonjour,

Essaie ceci :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub CommandButton5_Click()
Dim NomFich As String, Chemin As String, Wbk As Workbook
 
If MsgBox("        Vous confirmez la création du NOUVEAU TARIFAIRE                 " & vbCr & "        Sans avoir oublié de remplir les renseignements de la 1ère étape ?                " & vbCr & " " & vbCr & "                - Le Mois et l'année du Nouveau Tarifaire " & vbCr & "                - Le Taux de Marge Budgeté du mois a venir ", vbYesNo + vbQuestion, "Renseignements") = vbNo Then Exit Sub
 
With ThisWorkbook.Sheets("COEFFICIENTS")
    NomFich = .Range("E54")
    'la cellule E54 doit contenir le nom du fichier à ouvrir avec son extension TARIF BOUCHERIE.xls
    'si la cellule ne contient que TARIF BOUCHERIE --> NomFich = .Range("E54") & ".xls"
    Chemin = .Range("D61")
    'la cellule D61 doit contenir le chemin complet du fichier à ouvrir (exemple : C:\Rep\SousRep\)
    Set Wbk = Workbooks.Open(Chemin & NomFich)
 
    Wbk.Sheets("PARAMETRAGE").Range("A2") = .Range("D49")
    Wbk.Sheets("PARAMETRAGE").Range("B2") = .Range("D48")
    ThisWorkbook.Sheets("TARIF V BOVINE").Range("E6:M52").Copy Wbk.Sheets("VIANDE BOVINE").Range("E6:M52")
End With
 
Wbk.Close True
Unload Me
ThisWorkbook.Close
 
End Sub

Bonjour le Forum,
Fring, j'ai essayé ta proposition le fichier s'ouvre la liaison des copier coller marche en revanche je bloque sur la userform du fichier, elle reste apparente et de ce fait mon fichier ne se ferme pas appres le copier coller j'ai essaye de lancer une application.run afin de fermer la userform mais rien !!

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub CommandButton5_Click()
Dim NomFich As String, Chemin As String, Wbk As Workbook
 
If MsgBox("        Vous confirmez la création du NOUVEAU TARIFAIRE                 " & vbCr & "        Sans avoir oublié de remplir les renseignements de la 1ère étape ?                " & vbCr & " " & vbCr & "                - Le Mois et l'année du Nouveau Tarifaire " & vbCr & "                - Le Taux de Marge Budgeté du mois a venir ", vbYesNo + vbQuestion, "Renseignements") = vbNo Then Exit Sub
 
With ThisWorkbook.Sheets("COEFFICIENTS")
    NomFich = .Range("E54")
    'la cellule E54 doit contenir le nom du fichier à ouvrir avec son extension TARIF BOUCHERIE.xls
    'si la cellule ne contient que TARIF BOUCHERIE --> NomFich = .Range("E54") & ".xls"
    Chemin = .Range("D61")
    'la cellule D61 doit contenir le chemin complet du fichier à ouvrir (exemple : C:\Rep\SousRep\)
    Set Wbk = Workbooks.Open(Chemin & NomFich)
 
    Wbk.Sheets("PARAMETRAGE").Range("A2") = .Range("D49")
    Wbk.Sheets("PARAMETRAGE").Range("B2") = .Range("D48")
    ThisWorkbook.Sheets("TARIF V BOVINE").Range("E6:M52").Copy Wbk.Sheets("VIANDE BOVINE").Range("E6:M52")
End With
 
'Wbk.Application.Run "fermeture1"
Wbk.Close True
Unload Me
ThisWorkbook.Close

03/01/2011, 09h05
fring
Je ne vois pas à quoi sert ce UserForm dans le second fichier.
Plusieurs solutions possibles :
- soit supprimer l'affichage de ce UserForm
- soit, dans le fichier comportant ce UserForm, ajouter une commande Unload du UserForm en question avant la fermeture de ce fichier
- soit mettre la propriété ShowModal de ce UserForm sur False
03/01/2011, 11h42
patricktoulon

re

bonjour

une solution serai d'utiliser les apis

boucler sur toute les fenêtres actives tester si c'est un userform (tester si c'est un thunder *8 ou *D ) déterminer le handle et après close handle

regarde du coté de getactivewindow,handle,

c'est la boucle que je ne saurait pas faire peut être que fring pourrait compléter mon idée
au plaisir
03/01/2011, 14h26
VELO1222
Bonjour le Forum,
Pour repondre aux questions,
- soit supprimer l'affichage de ce UserForm
- soit, dans le fichier comportant ce UserForm, ajouter une commande Unload du UserForm en question avant la fermeture de ce fichier
- soit mettre la propriété ShowModal de ce UserForm sur False
1. Il me faut impérativement l'affichage de ce userform sinon mon fichier n'a aucun interet
2. Mon probleme est que je ne souhaite pas fermer moi meme ce fichier mais qu'il se fasse de lui meme dans la programmation
3. En modifiant le ShowModal je me trouve avec une erreur visual "chemin accès non trouvé"
4. Et pour repondre a Patrick je n'ai pas l'expertise pour comprendre sa proposition
Merci de votre aide
Tony
04/01/2011, 16h47
fring

Tu ouvres un fichier, tu y colles des données et ensuite tu le refermes...je ne vois toujours pas à quoi sert ce UserForm dans ce fichier ?

Citation:

Envoyé par VELO1222

En modifiant le ShowModal je me trouve avec une erreur visual "chemin accès non trouvé"

Sur quelle ligne de code cette erreur ?
04/01/2011, 17h23
VELO1222

Bonjour Fring, bonjour le forum,
Le fichier avec ce userform sert a mes collabarteur a l'ouverture du fichier ils se trouvent devant ce userform et ils s'identifient partir d'un combobox afin d'avoir leurs données et de les imprimer.
Ensuite l'erreur est apparu dans une fenetre pas sur une ligne de la programmation
cdt
Tony
04/01/2011, 17h49
fring

Je commence à comprendre, enfin je crois...:aie:
Il ne faut pas mettre le code de copie des données, de sauvegarde et de fermeture dans le 1er classeur mais dans le second classeur, celui qui reçoit les données et pour lequel les utilisateurs doivent s'identifier.

Mais...si le second classeur est simplement une base de données des tarifs, je ne travaillerais pas comme ça. Le UserForm d'identification, je le mettrais dans le premier classeur et si identifiant = OK --> on ouvre le second classeur (en mode invisible avec un SreenUpdating sur False par exemple) et on copie les données, ce qui pourrait même se faire sans ouvrir le second classeur.
04/01/2011, 18h49
VELO1222

re Bonsoir Fring,
le petit probleme est que je ne peux mettre a disposition que le fichier avec ce userform du a sa taille car il ne contient que des feuilles de tarifs le premier fichier a une taille de 13Mo il me sert a effectué les tarifs et dans mon entreprise je peux mettre a disposition sur intranet que des fichiers ayant une taille inferieur a 1,5Mo
cdt
Tony