Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Macro + fermeture classeur

Macro + fermeture classeur

15 réponses
Avatar
Nicolas
J'ai la macro suivante

Windows("0 Est Tecno Master 2005eee1").Activate
ActiveWindow.Close (savechanges = False)

qui est supposer fermer mon fichier 0 Est Tecno Master 2005eee1 (qui est un
model .xlt) sans me demander de sauvegarder mais il m'apparait quand meme
une fenetre de sauvegarder sous .....

ya quelqu'un qui a une iddée pk ? et si je met mon extension .xlt comme sa

Windows("0 Est Tecno Master 2005eee1.xlt").Activate
ActiveWindow.Close (savechanges = False)

et bien il ne le trouve pas !

mais si je le met en xls

Windows("0 Est Tecno Master 2005eee1.xls").Activate
ActiveWindow.Close (savechanges = False)

tout ferme comme il faut et tout fonctionne #1

bizzard non ?

merce d'avance de votre aide
Signaler un problème avec ce contenu

5 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
Nicolas
Ok voici mon codage avec modification !

'---------------------------------
Private Sub CommandButton1_Click()

Dim Rst As New ADODB.Recordset
Dim Con As ADODB.Connection
Dim NbChamps As Integer
Dim NomFichier As String
Dim Arr As Variant, Nb As Long

'à définir le chemin et le nom de ton modèle
NomFichier = Application.TemplatesPath & "" & "0 Est Tecno Master
2005bon.xlt"
Set Con = New ADODB.Connection
Con.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & NomFichier &
";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'modifie le nom de la feuille et l'adresse où se retrouve
'tes données dans ton modèle
Requete = "SELECT * From [Items$A31:L126]"
'Exécution de la requête
Rst.Open Requete, Con, adOpenStatic, adLockOptimistic
'Si le recordset n'est pas vide...
If Rst.EOF = False Then
Nb = Rst.RecordCount
Application.EnableEvents = False
Arr = Rst.GetRows
'Indique la première cellule de la colonne où doivent
'être copié les données, inclus dans la plage la cellule
'servant d'étiquette.
NbChamps = Rst.Fields.Count
Range("A31").Resize(Nb, NbChamps) = WorksheetFunction.Transpose(Arr)
Application.EnableEvents = True
Else
MsgBox "Aucune donnée disponible. Mise à jour impossible."
End If
'Ferme le recordset
Rst.Close: Con.Close
Set Rst = Nothing: Set Con = Nothing

End Sub
'---------------------------------

Sa fonctionne super bien mais le range
maximum que je peu mettre c'est
Requete = "SELECT * From [Items$A31:L126]"
et le range que je veut c'est au moin A31:L216 ...... et plus !!!
j'ai meme envi de mettre tout la page au complet car il va ce
rajouter des items sa ses sur et certain.
il me fait un erreur d'execution 13 !!! a la ligne
Range("A31").Resize(Nb, NbChamps) = WorksheetFunction.Transpose(Arr)
si je met un range trop grand :(

une autre solution ???
tk merci de ta patiente mais c'est juste ce detail qui me reste a regler



"Nicolas" a écrit dans le message de news:

Voici ce que j'ai essayer

'---------------------------------
Private Sub CommandButton1_Click()

Dim Rst As New ADODB.Recordset
Dim Con As ADODB.Connection

Dim NomFichier As String
Dim Arr As Variant, Nb As Long

'à définir le chemin et le nom de ton modèle
'NomFichier = ThisWorkbook.Path & "0 Est Tecno Master 2005bon.xlt"
NomFichier = Application.TemplatesPath & "" & "Test.xlt"
Set Con = New ADODB.Connection
Con.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & NomFichier
& ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'modifie le nom de la feuille et l'adresse où se retrouve
'tes données dans ton modèle
Requete = "SELECT * From [Feuil1$A1:N300]"
'Exécution de la requête
Rst.Open Requete, Con, adOpenStatic, adLockOptimistic
'Si le recordset n'est pas vide...
If Rst.EOF = False Then
Nb = Rst.RecordCount
Application.EnableEvents = False
Arr = Rst.GetRows
'Indique la première cellule de la colonne où doivent
'être copié les données, inclus dans la plage la cellule
'servant d'étiquette.
Range("A1").Resize(Nb) = WorksheetFunction.Transpose(Arr)
Application.EnableEvents = True
Else
MsgBox "Aucune donnée disponible. Mise à jour impossible."
End If
'Ferme le recordset
Rst.Close: Con.Close
'----------------------------------------

Il me fait un erreur a Range("A1").Resize(Nb) =
WorksheetFunction.Transpose(Arr)
et si je met Requete = "SELECT * From [Feuil1$A1:A300]" au lieu de Requete
= "SELECT * From [Feuil1$A1:N300]"
sa fonctionne mais la case A1 et bien c'est la case A2 de mon test.xlt
donc il est decaller de 1 :(

tk je vais travailler la dessus merci de ton precieuse aide

"michdenis" a écrit dans le message de news:

Bonjour Nicolas,

Tu crées dans ta feuille qui doit être mise à jour un bouton de commande
issu de la barre d'outils "contrôle" et tu copies dans
l'événement "Clic" la procédure suivante :

Pour exécuter cette macro, tu dois ajouter la référence suivante à ton
projet.

Ouvre VBE (visual basic editor), barre des menus / outils / référence /
et tu coches : "Microsoft Activex data objet 2.8 librairy"
si tu n'as pas 2.8, tu coches la plus récente...

Prend le temps de lire la macro, et d'apporter les correctifs pour
qu'elle
corresponde à ton application.

'---------------------------------
Private Sub CommandButton1_Click()

Dim Rst As New ADODB.Recordset
Dim Con As ADODB.Connection

Dim NomFichier As String
Dim Arr As Variant, Nb As Long

'à définir le chemin et le nom de ton modèle
NomFichier = ThisWorkbook.Path & "données.xls"

Set Con = New ADODB.Connection
Con.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & NomFichier & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'modifie le nom de la feuille et l'adresse où se retrouve
'tes données dans ton modèle
Requete = "SELECT * From [Feuil1$B1:B10]"
'Exécution de la requête
Rst.Open Requete, Con, adOpenStatic, adLockOptimistic
'Si le recordset n'est pas vide...
If Rst.EOF = False Then
Nb = Rst.RecordCount
Application.EnableEvents = False
Arr = Rst.GetRows
'Indique la première cellule de la colonne où doivent
'être copié les données, inclus dans la plage la cellule
'servant d'étiquette.
Range("A1").Resize(Nb) = WorksheetFunction.Transpose(Arr)
Application.EnableEvents = True
Else
MsgBox "Aucune donnée disponible. Mise à jour impossible."
End If
'Ferme le recordset
Rst.Close: Con.Close
Set Rst = Nothing: Set Con = Nothing

End Sub
'---------------------------------




"Nicolas" a écrit dans le message de news:

ok dsl
j'ai des fichier excel (xls) qui son parreil comme mon modele xlt
dans le fond si je change le prix d''un item dans mon modele et que je
reeouvre un de mes fichier xls et bien j'ai un bouton qui fait une mise a
jour de ma liste d'item dans mon xls.
il copy tout la feuille item de mon modele et il la recolle dans ma
feuille
item de mon xls pour etre sur que je suis a jour dans mes prix !
mais tu me fais penser a sa et je pense que je me complique peut-etre la
vie
pour rien .... tk si ta une iddé propose et je ferrais :)

merci

"michdenis" a écrit dans le message de news:

Bonjour Nicolas,

Il manque quelque chose d'essentiel à ta question, Qu'est-ce que tu veux
faire ? Je ne veux pas que tu commentes ton code, je veux
simplement que tu m'expliques ce que tu tentes de réaliser.


Salutations!


"Nicolas" a écrit dans le message de news:

j'ai essayer ce que tu ma envoyer et sa fonctionne il ecrit le bon titre
dans la barre en haut "0 Est Tecno Master 2005eee.xlt"
mais le probleme c'est qu'il me bloque a la formule d'ensuite :(
voici mon codage sa peux peut-etre d'aider en tk moi je comprend pas
pourquoi qu'il ne fonctionne pas :(

If MsgBox("Vous etes sur le point de mettre a jour la liste d'item du
classeur " & ActiveWorkbook.Name & ". Êtes-vous sur de vouloir continuer
?",
vbYesNo) = vbNo Then
Exit Sub
Else
Nom = ActiveWorkbook.Name
Sheets("Items").Select
Rows("27:27").Select
ActiveWindow.FreezePanes = False
ActiveWindow.SmallScroll Down:=-36
Cells.Select
'Workbooks.Open "Z:ExcelgiEstimation Techno 2005 Est Tecno Master
2005eee.xlt" ' **** ANCIENNE COMMANDE POUR OUVRIR MON XLT ****
Call OuvrirUnModeleExcel ' **** LA NOUVELLE COMMANDE POUR OUVRIR MON
XLT
QUI FONCTIONNE #1 ****
' **** IL BLOQUE A L'ÉTAPE QUI SUIS !!! ****
Windows("0 Est Tecno Master 2005eee.xlt").Activate ' **** ERREUR
D'EXCUTION
'9' L'INDICE N'APPARTIEN PAS A LA SELECTION ****
Sheets("Items").Select
Rows("27:27").Select
ActiveWindow.FreezePanes = False
ActiveWindow.SmallScroll Down:=-45
Cells.Select
Selection.Copy
Range("A1").Select
Workbooks(Nom).Activate
Cells.Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
skipblanks: >>> _
False, Transpose:úlse
Range("A1").Select
ActiveWindow.SmallScroll Down:&
Range("A28").Select
ActiveWindow.FreezePanes = True
Application.CutCopyMode = False
Windows("0 Est Tecno Master 2005eee.xlt").Activate
ActiveWindow.Close (savechanges = False)
End If
End Sub

tk c'est compliquer mais bon si tu trouve pas je vais essayer de me
debrouiller autrement merci de ton aide.

"michdenis" a écrit dans le message de news:


Bonjour Nicolas,

Si tu désires ouvrir en utilisant VBA, un modèle excel comme modèle
(fichier xlt),

Tu peux utiliser ceci :

Copie ceci dans un module standard et assure toi de copier la
déclaration
des Api dans le haut de module avant toutes procédures.

'Api pour la commande ShellExecute
Private Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal Hwnd As Long, ByVal lpszOp As _
String, ByVal lpszFile As String, ByVal lpszParams As String, _
ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long

'Api pour déterminer le Hwnd (handle de la fenêtre)
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'----------------------------------------
Sub OuvrirUnModeleExcel()

'ouvrir un modèle excel comme fichier xlt
'pour pouvoir le modifier

Const SW_SHOWNORMAL = 1
Dim Hwnd As Long
Dim Fich As String

'Adapter le chemin et le nom du modèle selon vos désirs
Fich = Application.TemplatesPath & "" & "Feuille.xlt"

'Test pour valider si le fichier existe ...
If Dir(Fich) <> "" Then
Hwnd = FindWindow(vbNullString, Application.Caption)
ShellExecute Hwnd, "open", Fich, vbNullString, vbNullString,
SW_SHOWNORMAL
Else
MsgBox "Fichier ou chemin inexistant"
End If
End Sub
'----------------------------------------


Salutations!


"Nicolas" a écrit dans le message de news:

moi dans ma barre en haut j'ai pas l'extention du .xlt
dans ma macro plus haut je l'ouvre de cette facon
Workbooks.Open "S:ExcelgiEstimation Techno 2005 Est Tecno Master
2005eee.xlt"
mais dans la barre en haut c'est marquer comme sa
0 Est Tecno Master 2005eee1

pis si je l'ouvre normalement (sans la macro) avec fichier.....ouvrir
et
bien le nom est corrcet dans le haut 0 Est Tecno Master 2005eee.xlt
bizzzz

je croi que ses a cause de sa qu'il me demande d'enregister sous meme
si
il
est a false !

merci


"michdenis" a écrit dans le message de news:

Bonjour Nicolas,

J'ai testé ceci sous excel 2003

Le document Feuille.xlt est ouvert comme modèle... dans la barre de
titre
son nom est complet et l'extension .xlt est visible.
Est-ce ton cas ? Ou est-ce que ton fichier n'a pas d'extension ...
parce
qu'alors il n'est pas ouvert à titre de modèle mais comme
futur classeur .xls.

Windows("Feuille.xlt").Activate
ActiveWindow.Close (savechanges = False)

Aucun problème avec des 2 lignes de code.


Salutations!




"Nicolas" a écrit dans le message de news:
%
J'ai la macro suivante

Windows("0 Est Tecno Master 2005eee1").Activate
ActiveWindow.Close (savechanges = False)

qui est supposer fermer mon fichier 0 Est Tecno Master 2005eee1 (qui
est
un
model .xlt) sans me demander de sauvegarder mais il m'apparait quand
meme
une fenetre de sauvegarder sous .....

ya quelqu'un qui a une iddée pk ? et si je met mon extension .xlt
comme
sa

Windows("0 Est Tecno Master 2005eee1.xlt").Activate
ActiveWindow.Close (savechanges = False)

et bien il ne le trouve pas !

mais si je le met en xls

Windows("0 Est Tecno Master 2005eee1.xls").Activate
ActiveWindow.Close (savechanges = False)

tout ferme comme il faut et tout fonctionne #1

bizzard non ?

merce d'avance de votre aide
























Avatar
Nicolas
Ok voici mon codage avec modification !

'---------------------------------
Private Sub CommandButton1_Click()

Dim Rst As New ADODB.Recordset
Dim Con As ADODB.Connection
Dim NbChamps As Integer
Dim NomFichier As String
Dim Arr As Variant, Nb As Long

'à définir le chemin et le nom de ton modèle
NomFichier = Application.TemplatesPath & "" & "0 Est Tecno Master
2005bon.xlt"
Set Con = New ADODB.Connection
Con.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & NomFichier &
";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'modifie le nom de la feuille et l'adresse où se retrouve
'tes données dans ton modèle
Requete = "SELECT * From [Items$A31:L126]"
'Exécution de la requête
Rst.Open Requete, Con, adOpenStatic, adLockOptimistic
'Si le recordset n'est pas vide...
If Rst.EOF = False Then
Nb = Rst.RecordCount
Application.EnableEvents = False
Arr = Rst.GetRows
'Indique la première cellule de la colonne où doivent
'être copié les données, inclus dans la plage la cellule
'servant d'étiquette.
NbChamps = Rst.Fields.Count
Range("A31").Resize(Nb, NbChamps) = WorksheetFunction.Transpose(Arr)
Application.EnableEvents = True
Else
MsgBox "Aucune donnée disponible. Mise à jour impossible."
End If
'Ferme le recordset
Rst.Close: Con.Close
Set Rst = Nothing: Set Con = Nothing

End Sub
'---------------------------------

Sa fonctionne super bien mais le range
maximum que je peu mettre c'est
Requete = "SELECT * From [Items$A31:L126]"
et le range que je veut c'est au moin A31:L216 ...... et plus !!!
j'ai meme envi de mettre tout la page au complet car il va ce
rajouter des items sa ses sur et certain.
il me fait un erreur d'execution 13 !!! a la ligne
Range("A31").Resize(Nb, NbChamps) = WorksheetFunction.Transpose(Arr)
si je met un range trop grand :(

une autre solution ???
tk merci de ta patiente mais c'est juste ce detail qui me reste a regler

"michdenis" a écrit dans le message de news:

Bonjour Nicolas,

Tu crées dans ta feuille qui doit être mise à jour un bouton de commande
issu de la barre d'outils "contrôle" et tu copies dans
l'événement "Clic" la procédure suivante :

Pour exécuter cette macro, tu dois ajouter la référence suivante à ton
projet.

Ouvre VBE (visual basic editor), barre des menus / outils / référence /
et tu coches : "Microsoft Activex data objet 2.8 librairy"
si tu n'as pas 2.8, tu coches la plus récente...

Prend le temps de lire la macro, et d'apporter les correctifs pour qu'elle
corresponde à ton application.

'---------------------------------
Private Sub CommandButton1_Click()

Dim Rst As New ADODB.Recordset
Dim Con As ADODB.Connection

Dim NomFichier As String
Dim Arr As Variant, Nb As Long

'à définir le chemin et le nom de ton modèle
NomFichier = ThisWorkbook.Path & "données.xls"

Set Con = New ADODB.Connection
Con.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & NomFichier & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'modifie le nom de la feuille et l'adresse où se retrouve
'tes données dans ton modèle
Requete = "SELECT * From [Feuil1$B1:B10]"
'Exécution de la requête
Rst.Open Requete, Con, adOpenStatic, adLockOptimistic
'Si le recordset n'est pas vide...
If Rst.EOF = False Then
Nb = Rst.RecordCount
Application.EnableEvents = False
Arr = Rst.GetRows
'Indique la première cellule de la colonne où doivent
'être copié les données, inclus dans la plage la cellule
'servant d'étiquette.
Range("A1").Resize(Nb) = WorksheetFunction.Transpose(Arr)
Application.EnableEvents = True
Else
MsgBox "Aucune donnée disponible. Mise à jour impossible."
End If
'Ferme le recordset
Rst.Close: Con.Close
Set Rst = Nothing: Set Con = Nothing

End Sub
'---------------------------------




"Nicolas" a écrit dans le message de news:

ok dsl
j'ai des fichier excel (xls) qui son parreil comme mon modele xlt
dans le fond si je change le prix d''un item dans mon modele et que je
reeouvre un de mes fichier xls et bien j'ai un bouton qui fait une mise a
jour de ma liste d'item dans mon xls.
il copy tout la feuille item de mon modele et il la recolle dans ma
feuille
item de mon xls pour etre sur que je suis a jour dans mes prix !
mais tu me fais penser a sa et je pense que je me complique peut-etre la
vie
pour rien .... tk si ta une iddé propose et je ferrais :)

merci

"michdenis" a écrit dans le message de news:

Bonjour Nicolas,

Il manque quelque chose d'essentiel à ta question, Qu'est-ce que tu veux
faire ? Je ne veux pas que tu commentes ton code, je veux
simplement que tu m'expliques ce que tu tentes de réaliser.


Salutations!


"Nicolas" a écrit dans le message de news:

j'ai essayer ce que tu ma envoyer et sa fonctionne il ecrit le bon titre
dans la barre en haut "0 Est Tecno Master 2005eee.xlt"
mais le probleme c'est qu'il me bloque a la formule d'ensuite :(
voici mon codage sa peux peut-etre d'aider en tk moi je comprend pas
pourquoi qu'il ne fonctionne pas :(

If MsgBox("Vous etes sur le point de mettre a jour la liste d'item du
classeur " & ActiveWorkbook.Name & ". Êtes-vous sur de vouloir continuer
?",
vbYesNo) = vbNo Then
Exit Sub
Else
Nom = ActiveWorkbook.Name
Sheets("Items").Select
Rows("27:27").Select
ActiveWindow.FreezePanes = False
ActiveWindow.SmallScroll Down:=-36
Cells.Select
'Workbooks.Open "Z:ExcelgiEstimation Techno 2005 Est Tecno Master
2005eee.xlt" ' **** ANCIENNE COMMANDE POUR OUVRIR MON XLT ****
Call OuvrirUnModeleExcel ' **** LA NOUVELLE COMMANDE POUR OUVRIR MON XLT
QUI FONCTIONNE #1 ****
' **** IL BLOQUE A L'ÉTAPE QUI SUIS !!! ****
Windows("0 Est Tecno Master 2005eee.xlt").Activate ' **** ERREUR
D'EXCUTION
'9' L'INDICE N'APPARTIEN PAS A LA SELECTION ****
Sheets("Items").Select
Rows("27:27").Select
ActiveWindow.FreezePanes = False
ActiveWindow.SmallScroll Down:=-45
Cells.Select
Selection.Copy
Range("A1").Select
Workbooks(Nom).Activate
Cells.Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, skipblanks: >> _
False, Transpose:úlse
Range("A1").Select
ActiveWindow.SmallScroll Down:&
Range("A28").Select
ActiveWindow.FreezePanes = True
Application.CutCopyMode = False
Windows("0 Est Tecno Master 2005eee.xlt").Activate
ActiveWindow.Close (savechanges = False)
End If
End Sub

tk c'est compliquer mais bon si tu trouve pas je vais essayer de me
debrouiller autrement merci de ton aide.

"michdenis" a écrit dans le message de news:


Bonjour Nicolas,

Si tu désires ouvrir en utilisant VBA, un modèle excel comme modèle
(fichier xlt),

Tu peux utiliser ceci :

Copie ceci dans un module standard et assure toi de copier la
déclaration
des Api dans le haut de module avant toutes procédures.

'Api pour la commande ShellExecute
Private Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal Hwnd As Long, ByVal lpszOp As _
String, ByVal lpszFile As String, ByVal lpszParams As String, _
ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long

'Api pour déterminer le Hwnd (handle de la fenêtre)
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'----------------------------------------
Sub OuvrirUnModeleExcel()

'ouvrir un modèle excel comme fichier xlt
'pour pouvoir le modifier

Const SW_SHOWNORMAL = 1
Dim Hwnd As Long
Dim Fich As String

'Adapter le chemin et le nom du modèle selon vos désirs
Fich = Application.TemplatesPath & "" & "Feuille.xlt"

'Test pour valider si le fichier existe ...
If Dir(Fich) <> "" Then
Hwnd = FindWindow(vbNullString, Application.Caption)
ShellExecute Hwnd, "open", Fich, vbNullString, vbNullString,
SW_SHOWNORMAL
Else
MsgBox "Fichier ou chemin inexistant"
End If
End Sub
'----------------------------------------


Salutations!


"Nicolas" a écrit dans le message de news:

moi dans ma barre en haut j'ai pas l'extention du .xlt
dans ma macro plus haut je l'ouvre de cette facon
Workbooks.Open "S:ExcelgiEstimation Techno 2005 Est Tecno Master
2005eee.xlt"
mais dans la barre en haut c'est marquer comme sa
0 Est Tecno Master 2005eee1

pis si je l'ouvre normalement (sans la macro) avec fichier.....ouvrir et
bien le nom est corrcet dans le haut 0 Est Tecno Master 2005eee.xlt
bizzzz

je croi que ses a cause de sa qu'il me demande d'enregister sous meme si
il
est a false !

merci


"michdenis" a écrit dans le message de news:

Bonjour Nicolas,

J'ai testé ceci sous excel 2003

Le document Feuille.xlt est ouvert comme modèle... dans la barre de
titre
son nom est complet et l'extension .xlt est visible.
Est-ce ton cas ? Ou est-ce que ton fichier n'a pas d'extension ...
parce
qu'alors il n'est pas ouvert à titre de modèle mais comme
futur classeur .xls.

Windows("Feuille.xlt").Activate
ActiveWindow.Close (savechanges = False)

Aucun problème avec des 2 lignes de code.


Salutations!




"Nicolas" a écrit dans le message de news:
%
J'ai la macro suivante

Windows("0 Est Tecno Master 2005eee1").Activate
ActiveWindow.Close (savechanges = False)

qui est supposer fermer mon fichier 0 Est Tecno Master 2005eee1 (qui
est
un
model .xlt) sans me demander de sauvegarder mais il m'apparait quand
meme
une fenetre de sauvegarder sous .....

ya quelqu'un qui a une iddée pk ? et si je met mon extension .xlt comme
sa

Windows("0 Est Tecno Master 2005eee1.xlt").Activate
ActiveWindow.Close (savechanges = False)

et bien il ne le trouve pas !

mais si je le met en xls

Windows("0 Est Tecno Master 2005eee1.xls").Activate
ActiveWindow.Close (savechanges = False)

tout ferme comme il faut et tout fonctionne #1

bizzard non ?

merce d'avance de votre aide




















Avatar
michdenis
Bonjour Nicolas,

voici une adaptation de la même procédure : Je l'ai testée avec 10500 lignes et 104 colonnes et aucun problème.

Indique à nouveau le nom de ton fichier dans la procédure.

Cette nouvelle procédure va recopier l'intégralité de tes données contenues dans ton fichier source.

Est-ce que cela fonctionne ?

'---------------------------------------
Private Sub CommandButton1_Click()

Dim Rst As New ADODB.Recordset
Dim Con As ADODB.Connection

Dim NomFichier As String

'à définir le chemin et le nom de ton modèle
NomFichier = ThisWorkbook.Path & "données.xls"

Set Con = New ADODB.Connection
Con.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & NomFichier & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'modifie le nom de la feuille et l'adresse où se retrouve
'tes données dans ton modèle
Requete = "SELECT * From [Feuil1$]"
'Exécution de la requête
Rst.Open Requete, Con, adOpenStatic, adLockOptimistic
'Si le recordset n'est pas vide...
If Rst.EOF = False Then
Application.EnableEvents = False
Range("A1").CopyFromRecordset Rst
Application.EnableEvents = True
Else
MsgBox "Aucune donnée disponible. Mise à jour impossible."
End If
'Ferme le recordset
Rst.Close: Con.Close
Set Rst = Nothing: Set Con = Nothing

End Sub
'---------------------------------------


Salutations!



"Nicolas" a écrit dans le message de news: %
Ok voici mon codage avec modification !

'---------------------------------
Private Sub CommandButton1_Click()

Dim Rst As New ADODB.Recordset
Dim Con As ADODB.Connection
Dim NbChamps As Integer
Dim NomFichier As String
Dim Arr As Variant, Nb As Long

'à définir le chemin et le nom de ton modèle
NomFichier = Application.TemplatesPath & "" & "0 Est Tecno Master
2005bon.xlt"
Set Con = New ADODB.Connection
Con.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & NomFichier &
";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'modifie le nom de la feuille et l'adresse où se retrouve
'tes données dans ton modèle
Requete = "SELECT * From [Items$A31:L126]"
'Exécution de la requête
Rst.Open Requete, Con, adOpenStatic, adLockOptimistic
'Si le recordset n'est pas vide...
If Rst.EOF = False Then
Nb = Rst.RecordCount
Application.EnableEvents = False
Arr = Rst.GetRows
'Indique la première cellule de la colonne où doivent
'être copié les données, inclus dans la plage la cellule
'servant d'étiquette.
NbChamps = Rst.Fields.Count
Range("A31").Resize(Nb, NbChamps) = WorksheetFunction.Transpose(Arr)
Application.EnableEvents = True
Else
MsgBox "Aucune donnée disponible. Mise à jour impossible."
End If
'Ferme le recordset
Rst.Close: Con.Close
Set Rst = Nothing: Set Con = Nothing

End Sub
'---------------------------------

Sa fonctionne super bien mais le range
maximum que je peu mettre c'est
Requete = "SELECT * From [Items$A31:L126]"
et le range que je veut c'est au moin A31:L216 ...... et plus !!!
j'ai meme envi de mettre tout la page au complet car il va ce
rajouter des items sa ses sur et certain.
il me fait un erreur d'execution 13 !!! a la ligne
Range("A31").Resize(Nb, NbChamps) = WorksheetFunction.Transpose(Arr)
si je met un range trop grand :(

une autre solution ???
tk merci de ta patiente mais c'est juste ce detail qui me reste a regler

"michdenis" a écrit dans le message de news:

Bonjour Nicolas,

Tu crées dans ta feuille qui doit être mise à jour un bouton de commande
issu de la barre d'outils "contrôle" et tu copies dans
l'événement "Clic" la procédure suivante :

Pour exécuter cette macro, tu dois ajouter la référence suivante à ton
projet.

Ouvre VBE (visual basic editor), barre des menus / outils / référence /
et tu coches : "Microsoft Activex data objet 2.8 librairy"
si tu n'as pas 2.8, tu coches la plus récente...

Prend le temps de lire la macro, et d'apporter les correctifs pour qu'elle
corresponde à ton application.

'---------------------------------
Private Sub CommandButton1_Click()

Dim Rst As New ADODB.Recordset
Dim Con As ADODB.Connection

Dim NomFichier As String
Dim Arr As Variant, Nb As Long

'à définir le chemin et le nom de ton modèle
NomFichier = ThisWorkbook.Path & "données.xls"

Set Con = New ADODB.Connection
Con.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & NomFichier & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'modifie le nom de la feuille et l'adresse où se retrouve
'tes données dans ton modèle
Requete = "SELECT * From [Feuil1$B1:B10]"
'Exécution de la requête
Rst.Open Requete, Con, adOpenStatic, adLockOptimistic
'Si le recordset n'est pas vide...
If Rst.EOF = False Then
Nb = Rst.RecordCount
Application.EnableEvents = False
Arr = Rst.GetRows
'Indique la première cellule de la colonne où doivent
'être copié les données, inclus dans la plage la cellule
'servant d'étiquette.
Range("A1").Resize(Nb) = WorksheetFunction.Transpose(Arr)
Application.EnableEvents = True
Else
MsgBox "Aucune donnée disponible. Mise à jour impossible."
End If
'Ferme le recordset
Rst.Close: Con.Close
Set Rst = Nothing: Set Con = Nothing

End Sub
'---------------------------------




"Nicolas" a écrit dans le message de news:

ok dsl
j'ai des fichier excel (xls) qui son parreil comme mon modele xlt
dans le fond si je change le prix d''un item dans mon modele et que je
reeouvre un de mes fichier xls et bien j'ai un bouton qui fait une mise a
jour de ma liste d'item dans mon xls.
il copy tout la feuille item de mon modele et il la recolle dans ma
feuille
item de mon xls pour etre sur que je suis a jour dans mes prix !
mais tu me fais penser a sa et je pense que je me complique peut-etre la
vie
pour rien .... tk si ta une iddé propose et je ferrais :)

merci

"michdenis" a écrit dans le message de news:

Bonjour Nicolas,

Il manque quelque chose d'essentiel à ta question, Qu'est-ce que tu veux
faire ? Je ne veux pas que tu commentes ton code, je veux
simplement que tu m'expliques ce que tu tentes de réaliser.


Salutations!


"Nicolas" a écrit dans le message de news:

j'ai essayer ce que tu ma envoyer et sa fonctionne il ecrit le bon titre
dans la barre en haut "0 Est Tecno Master 2005eee.xlt"
mais le probleme c'est qu'il me bloque a la formule d'ensuite :(
voici mon codage sa peux peut-etre d'aider en tk moi je comprend pas
pourquoi qu'il ne fonctionne pas :(

If MsgBox("Vous etes sur le point de mettre a jour la liste d'item du
classeur " & ActiveWorkbook.Name & ". Êtes-vous sur de vouloir continuer
?",
vbYesNo) = vbNo Then
Exit Sub
Else
Nom = ActiveWorkbook.Name
Sheets("Items").Select
Rows("27:27").Select
ActiveWindow.FreezePanes = False
ActiveWindow.SmallScroll Down:=-36
Cells.Select
'Workbooks.Open "Z:ExcelgiEstimation Techno 2005 Est Tecno Master
2005eee.xlt" ' **** ANCIENNE COMMANDE POUR OUVRIR MON XLT ****
Call OuvrirUnModeleExcel ' **** LA NOUVELLE COMMANDE POUR OUVRIR MON XLT
QUI FONCTIONNE #1 ****
' **** IL BLOQUE A L'ÉTAPE QUI SUIS !!! ****
Windows("0 Est Tecno Master 2005eee.xlt").Activate ' **** ERREUR
D'EXCUTION
'9' L'INDICE N'APPARTIEN PAS A LA SELECTION ****
Sheets("Items").Select
Rows("27:27").Select
ActiveWindow.FreezePanes = False
ActiveWindow.SmallScroll Down:=-45
Cells.Select
Selection.Copy
Range("A1").Select
Workbooks(Nom).Activate
Cells.Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, skipblanks: >> _
False, Transpose:úlse
Range("A1").Select
ActiveWindow.SmallScroll Down:&
Range("A28").Select
ActiveWindow.FreezePanes = True
Application.CutCopyMode = False
Windows("0 Est Tecno Master 2005eee.xlt").Activate
ActiveWindow.Close (savechanges = False)
End If
End Sub

tk c'est compliquer mais bon si tu trouve pas je vais essayer de me
debrouiller autrement merci de ton aide.

"michdenis" a écrit dans le message de news:


Bonjour Nicolas,

Si tu désires ouvrir en utilisant VBA, un modèle excel comme modèle
(fichier xlt),

Tu peux utiliser ceci :

Copie ceci dans un module standard et assure toi de copier la
déclaration
des Api dans le haut de module avant toutes procédures.

'Api pour la commande ShellExecute
Private Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal Hwnd As Long, ByVal lpszOp As _
String, ByVal lpszFile As String, ByVal lpszParams As String, _
ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long

'Api pour déterminer le Hwnd (handle de la fenêtre)
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'----------------------------------------
Sub OuvrirUnModeleExcel()

'ouvrir un modèle excel comme fichier xlt
'pour pouvoir le modifier

Const SW_SHOWNORMAL = 1
Dim Hwnd As Long
Dim Fich As String

'Adapter le chemin et le nom du modèle selon vos désirs
Fich = Application.TemplatesPath & "" & "Feuille.xlt"

'Test pour valider si le fichier existe ...
If Dir(Fich) <> "" Then
Hwnd = FindWindow(vbNullString, Application.Caption)
ShellExecute Hwnd, "open", Fich, vbNullString, vbNullString,
SW_SHOWNORMAL
Else
MsgBox "Fichier ou chemin inexistant"
End If
End Sub
'----------------------------------------


Salutations!


"Nicolas" a écrit dans le message de news:

moi dans ma barre en haut j'ai pas l'extention du .xlt
dans ma macro plus haut je l'ouvre de cette facon
Workbooks.Open "S:ExcelgiEstimation Techno 2005 Est Tecno Master
2005eee.xlt"
mais dans la barre en haut c'est marquer comme sa
0 Est Tecno Master 2005eee1

pis si je l'ouvre normalement (sans la macro) avec fichier.....ouvrir et
bien le nom est corrcet dans le haut 0 Est Tecno Master 2005eee.xlt
bizzzz

je croi que ses a cause de sa qu'il me demande d'enregister sous meme si
il
est a false !

merci


"michdenis" a écrit dans le message de news:

Bonjour Nicolas,

J'ai testé ceci sous excel 2003

Le document Feuille.xlt est ouvert comme modèle... dans la barre de
titre
son nom est complet et l'extension .xlt est visible.
Est-ce ton cas ? Ou est-ce que ton fichier n'a pas d'extension ...
parce
qu'alors il n'est pas ouvert à titre de modèle mais comme
futur classeur .xls.

Windows("Feuille.xlt").Activate
ActiveWindow.Close (savechanges = False)

Aucun problème avec des 2 lignes de code.


Salutations!




"Nicolas" a écrit dans le message de news:
%
J'ai la macro suivante

Windows("0 Est Tecno Master 2005eee1").Activate
ActiveWindow.Close (savechanges = False)

qui est supposer fermer mon fichier 0 Est Tecno Master 2005eee1 (qui
est
un
model .xlt) sans me demander de sauvegarder mais il m'apparait quand
meme
une fenetre de sauvegarder sous .....

ya quelqu'un qui a une iddée pk ? et si je met mon extension .xlt comme
sa

Windows("0 Est Tecno Master 2005eee1.xlt").Activate
ActiveWindow.Close (savechanges = False)

et bien il ne le trouve pas !

mais si je le met en xls

Windows("0 Est Tecno Master 2005eee1.xls").Activate
ActiveWindow.Close (savechanges = False)

tout ferme comme il faut et tout fonctionne #1

bizzard non ?

merce d'avance de votre aide




















Avatar
Nicolas
salut,
sa copie sans erreur mais
il me manque des chose !!
exemple il me recopi pas la cellule A1 il commence a A2 ????
Mais 2 feuille son parreil a la base et ausitot que je la mes a jour
il me decall tout sa !!!
:(
merci

"michdenis" a écrit dans le message de news:

Bonjour Nicolas,

voici une adaptation de la même procédure : Je l'ai testée avec 10500
lignes et 104 colonnes et aucun problème.

Indique à nouveau le nom de ton fichier dans la procédure.

Cette nouvelle procédure va recopier l'intégralité de tes données
contenues dans ton fichier source.

Est-ce que cela fonctionne ?

'---------------------------------------
Private Sub CommandButton1_Click()

Dim Rst As New ADODB.Recordset
Dim Con As ADODB.Connection

Dim NomFichier As String

'à définir le chemin et le nom de ton modèle
NomFichier = ThisWorkbook.Path & "données.xls"

Set Con = New ADODB.Connection
Con.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & NomFichier & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'modifie le nom de la feuille et l'adresse où se retrouve
'tes données dans ton modèle
Requete = "SELECT * From [Feuil1$]"
'Exécution de la requête
Rst.Open Requete, Con, adOpenStatic, adLockOptimistic
'Si le recordset n'est pas vide...
If Rst.EOF = False Then
Application.EnableEvents = False
Range("A1").CopyFromRecordset Rst
Application.EnableEvents = True
Else
MsgBox "Aucune donnée disponible. Mise à jour impossible."
End If
'Ferme le recordset
Rst.Close: Con.Close
Set Rst = Nothing: Set Con = Nothing

End Sub
'---------------------------------------


Salutations!



"Nicolas" a écrit dans le message de news:
%
Ok voici mon codage avec modification !

'---------------------------------
Private Sub CommandButton1_Click()

Dim Rst As New ADODB.Recordset
Dim Con As ADODB.Connection
Dim NbChamps As Integer
Dim NomFichier As String
Dim Arr As Variant, Nb As Long

'à définir le chemin et le nom de ton modèle
NomFichier = Application.TemplatesPath & "" & "0 Est Tecno Master
2005bon.xlt"
Set Con = New ADODB.Connection
Con.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & NomFichier
&
";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'modifie le nom de la feuille et l'adresse où se retrouve
'tes données dans ton modèle
Requete = "SELECT * From [Items$A31:L126]"
'Exécution de la requête
Rst.Open Requete, Con, adOpenStatic, adLockOptimistic
'Si le recordset n'est pas vide...
If Rst.EOF = False Then
Nb = Rst.RecordCount
Application.EnableEvents = False
Arr = Rst.GetRows
'Indique la première cellule de la colonne où doivent
'être copié les données, inclus dans la plage la cellule
'servant d'étiquette.
NbChamps = Rst.Fields.Count
Range("A31").Resize(Nb, NbChamps) = WorksheetFunction.Transpose(Arr)
Application.EnableEvents = True
Else
MsgBox "Aucune donnée disponible. Mise à jour impossible."
End If
'Ferme le recordset
Rst.Close: Con.Close
Set Rst = Nothing: Set Con = Nothing

End Sub
'---------------------------------

Sa fonctionne super bien mais le range
maximum que je peu mettre c'est
Requete = "SELECT * From [Items$A31:L126]"
et le range que je veut c'est au moin A31:L216 ...... et plus !!!
j'ai meme envi de mettre tout la page au complet car il va ce
rajouter des items sa ses sur et certain.
il me fait un erreur d'execution 13 !!! a la ligne
Range("A31").Resize(Nb, NbChamps) = WorksheetFunction.Transpose(Arr)
si je met un range trop grand :(

une autre solution ???
tk merci de ta patiente mais c'est juste ce detail qui me reste a regler

"michdenis" a écrit dans le message de news:

Bonjour Nicolas,

Tu crées dans ta feuille qui doit être mise à jour un bouton de commande
issu de la barre d'outils "contrôle" et tu copies dans
l'événement "Clic" la procédure suivante :

Pour exécuter cette macro, tu dois ajouter la référence suivante à ton
projet.

Ouvre VBE (visual basic editor), barre des menus / outils / référence /
et tu coches : "Microsoft Activex data objet 2.8 librairy"
si tu n'as pas 2.8, tu coches la plus récente...

Prend le temps de lire la macro, et d'apporter les correctifs pour
qu'elle
corresponde à ton application.

'---------------------------------
Private Sub CommandButton1_Click()

Dim Rst As New ADODB.Recordset
Dim Con As ADODB.Connection

Dim NomFichier As String
Dim Arr As Variant, Nb As Long

'à définir le chemin et le nom de ton modèle
NomFichier = ThisWorkbook.Path & "données.xls"

Set Con = New ADODB.Connection
Con.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & NomFichier & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'modifie le nom de la feuille et l'adresse où se retrouve
'tes données dans ton modèle
Requete = "SELECT * From [Feuil1$B1:B10]"
'Exécution de la requête
Rst.Open Requete, Con, adOpenStatic, adLockOptimistic
'Si le recordset n'est pas vide...
If Rst.EOF = False Then
Nb = Rst.RecordCount
Application.EnableEvents = False
Arr = Rst.GetRows
'Indique la première cellule de la colonne où doivent
'être copié les données, inclus dans la plage la cellule
'servant d'étiquette.
Range("A1").Resize(Nb) = WorksheetFunction.Transpose(Arr)
Application.EnableEvents = True
Else
MsgBox "Aucune donnée disponible. Mise à jour impossible."
End If
'Ferme le recordset
Rst.Close: Con.Close
Set Rst = Nothing: Set Con = Nothing

End Sub
'---------------------------------




"Nicolas" a écrit dans le message de news:

ok dsl
j'ai des fichier excel (xls) qui son parreil comme mon modele xlt
dans le fond si je change le prix d''un item dans mon modele et que je
reeouvre un de mes fichier xls et bien j'ai un bouton qui fait une mise a
jour de ma liste d'item dans mon xls.
il copy tout la feuille item de mon modele et il la recolle dans ma
feuille
item de mon xls pour etre sur que je suis a jour dans mes prix !
mais tu me fais penser a sa et je pense que je me complique peut-etre la
vie
pour rien .... tk si ta une iddé propose et je ferrais :)

merci

"michdenis" a écrit dans le message de news:

Bonjour Nicolas,

Il manque quelque chose d'essentiel à ta question, Qu'est-ce que tu veux
faire ? Je ne veux pas que tu commentes ton code, je veux
simplement que tu m'expliques ce que tu tentes de réaliser.


Salutations!


"Nicolas" a écrit dans le message de news:

j'ai essayer ce que tu ma envoyer et sa fonctionne il ecrit le bon titre
dans la barre en haut "0 Est Tecno Master 2005eee.xlt"
mais le probleme c'est qu'il me bloque a la formule d'ensuite :(
voici mon codage sa peux peut-etre d'aider en tk moi je comprend pas
pourquoi qu'il ne fonctionne pas :(

If MsgBox("Vous etes sur le point de mettre a jour la liste d'item du
classeur " & ActiveWorkbook.Name & ". Êtes-vous sur de vouloir continuer
?",
vbYesNo) = vbNo Then
Exit Sub
Else
Nom = ActiveWorkbook.Name
Sheets("Items").Select
Rows("27:27").Select
ActiveWindow.FreezePanes = False
ActiveWindow.SmallScroll Down:=-36
Cells.Select
'Workbooks.Open "Z:ExcelgiEstimation Techno 2005 Est Tecno Master
2005eee.xlt" ' **** ANCIENNE COMMANDE POUR OUVRIR MON XLT ****
Call OuvrirUnModeleExcel ' **** LA NOUVELLE COMMANDE POUR OUVRIR MON
XLT
QUI FONCTIONNE #1 ****
' **** IL BLOQUE A L'ÉTAPE QUI SUIS !!! ****
Windows("0 Est Tecno Master 2005eee.xlt").Activate ' **** ERREUR
D'EXCUTION
'9' L'INDICE N'APPARTIEN PAS A LA SELECTION ****
Sheets("Items").Select
Rows("27:27").Select
ActiveWindow.FreezePanes = False
ActiveWindow.SmallScroll Down:=-45
Cells.Select
Selection.Copy
Range("A1").Select
Workbooks(Nom).Activate
Cells.Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
skipblanks: >>> _
False, Transpose:úlse
Range("A1").Select
ActiveWindow.SmallScroll Down:&
Range("A28").Select
ActiveWindow.FreezePanes = True
Application.CutCopyMode = False
Windows("0 Est Tecno Master 2005eee.xlt").Activate
ActiveWindow.Close (savechanges = False)
End If
End Sub

tk c'est compliquer mais bon si tu trouve pas je vais essayer de me
debrouiller autrement merci de ton aide.

"michdenis" a écrit dans le message de news:


Bonjour Nicolas,

Si tu désires ouvrir en utilisant VBA, un modèle excel comme modèle
(fichier xlt),

Tu peux utiliser ceci :

Copie ceci dans un module standard et assure toi de copier la
déclaration
des Api dans le haut de module avant toutes procédures.

'Api pour la commande ShellExecute
Private Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal Hwnd As Long, ByVal lpszOp As _
String, ByVal lpszFile As String, ByVal lpszParams As String, _
ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long

'Api pour déterminer le Hwnd (handle de la fenêtre)
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'----------------------------------------
Sub OuvrirUnModeleExcel()

'ouvrir un modèle excel comme fichier xlt
'pour pouvoir le modifier

Const SW_SHOWNORMAL = 1
Dim Hwnd As Long
Dim Fich As String

'Adapter le chemin et le nom du modèle selon vos désirs
Fich = Application.TemplatesPath & "" & "Feuille.xlt"

'Test pour valider si le fichier existe ...
If Dir(Fich) <> "" Then
Hwnd = FindWindow(vbNullString, Application.Caption)
ShellExecute Hwnd, "open", Fich, vbNullString, vbNullString,
SW_SHOWNORMAL
Else
MsgBox "Fichier ou chemin inexistant"
End If
End Sub
'----------------------------------------


Salutations!


"Nicolas" a écrit dans le message de news:

moi dans ma barre en haut j'ai pas l'extention du .xlt
dans ma macro plus haut je l'ouvre de cette facon
Workbooks.Open "S:ExcelgiEstimation Techno 2005 Est Tecno Master
2005eee.xlt"
mais dans la barre en haut c'est marquer comme sa
0 Est Tecno Master 2005eee1

pis si je l'ouvre normalement (sans la macro) avec fichier.....ouvrir
et
bien le nom est corrcet dans le haut 0 Est Tecno Master 2005eee.xlt
bizzzz

je croi que ses a cause de sa qu'il me demande d'enregister sous meme
si
il
est a false !

merci


"michdenis" a écrit dans le message de news:

Bonjour Nicolas,

J'ai testé ceci sous excel 2003

Le document Feuille.xlt est ouvert comme modèle... dans la barre de
titre
son nom est complet et l'extension .xlt est visible.
Est-ce ton cas ? Ou est-ce que ton fichier n'a pas d'extension ...
parce
qu'alors il n'est pas ouvert à titre de modèle mais comme
futur classeur .xls.

Windows("Feuille.xlt").Activate
ActiveWindow.Close (savechanges = False)

Aucun problème avec des 2 lignes de code.


Salutations!




"Nicolas" a écrit dans le message de news:
%
J'ai la macro suivante

Windows("0 Est Tecno Master 2005eee1").Activate
ActiveWindow.Close (savechanges = False)

qui est supposer fermer mon fichier 0 Est Tecno Master 2005eee1 (qui
est
un
model .xlt) sans me demander de sauvegarder mais il m'apparait quand
meme
une fenetre de sauvegarder sous .....

ya quelqu'un qui a une iddée pk ? et si je met mon extension .xlt
comme
sa

Windows("0 Est Tecno Master 2005eee1.xlt").Activate
ActiveWindow.Close (savechanges = False)

et bien il ne le trouve pas !

mais si je le met en xls

Windows("0 Est Tecno Master 2005eee1.xls").Activate
ActiveWindow.Close (savechanges = False)

tout ferme comme il faut et tout fonctionne #1

bizzard non ?

merce d'avance de votre aide

























Avatar
michdenis
Bonjour Nicolas,

Bien, il faudra voir comment sont placées tes données. Un tableau (table de données) a habituellement une ligne d'étiquettes
identifiant chacun des champs sans colonne laissé vide ... et les données sont en dessous.

J'ai légèrement modifié la procédure pour qu'elle tienne compte de la ligne d'étiquette :

'-----------------------------------------
Private Sub CommandButton1_Click()

Dim Rst As New ADODB.Recordset
Dim Con As ADODB.Connection
Dim A As Integer
Dim Fld As ADODB.Field
Dim NomFichier As String

'à définir le chemin et le nom de ton modèle
NomFichier = ThisWorkbook.Path & "données.xls"

Set Con = New ADODB.Connection
Con.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & NomFichier & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'modifie le nom de la feuille et l'adresse où se retrouve
'tes données dans ton modèle
Requete = "SELECT * From [Feuil1$]"
'Exécution de la requête
Rst.Open Requete, Con, adOpenStatic, adLockOptimistic
'Si le recordset n'est pas vide...
If Rst.EOF = False Then
Application.EnableEvents = False
For Each Fld In Rst.Fields
A = A + 1
Cells(, A) = Fld.Name
Next
Range("A2").CopyFromRecordset Rst
Application.EnableEvents = True
Else
MsgBox "Aucune donnée disponible. Mise à jour impossible."
End If
'Ferme le recordset
Rst.Close: Con.Close
Set Rst = Nothing: Set Con = Nothing: Set fld = Nothing

End Sub
'-------------------------------------


Salutations!


"Nicolas" a écrit dans le message de news:
salut,
sa copie sans erreur mais
il me manque des chose !!
exemple il me recopi pas la cellule A1 il commence a A2 ????
Mais 2 feuille son parreil a la base et ausitot que je la mes a jour
il me decall tout sa !!!
:(
merci

"michdenis" a écrit dans le message de news:

Bonjour Nicolas,

voici une adaptation de la même procédure : Je l'ai testée avec 10500
lignes et 104 colonnes et aucun problème.

Indique à nouveau le nom de ton fichier dans la procédure.

Cette nouvelle procédure va recopier l'intégralité de tes données
contenues dans ton fichier source.

Est-ce que cela fonctionne ?

'---------------------------------------
Private Sub CommandButton1_Click()

Dim Rst As New ADODB.Recordset
Dim Con As ADODB.Connection

Dim NomFichier As String

'à définir le chemin et le nom de ton modèle
NomFichier = ThisWorkbook.Path & "données.xls"

Set Con = New ADODB.Connection
Con.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & NomFichier & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'modifie le nom de la feuille et l'adresse où se retrouve
'tes données dans ton modèle
Requete = "SELECT * From [Feuil1$]"
'Exécution de la requête
Rst.Open Requete, Con, adOpenStatic, adLockOptimistic
'Si le recordset n'est pas vide...
If Rst.EOF = False Then
Application.EnableEvents = False
Range("A1").CopyFromRecordset Rst
Application.EnableEvents = True
Else
MsgBox "Aucune donnée disponible. Mise à jour impossible."
End If
'Ferme le recordset
Rst.Close: Con.Close
Set Rst = Nothing: Set Con = Nothing

End Sub
'---------------------------------------


Salutations!



"Nicolas" a écrit dans le message de news:
%
Ok voici mon codage avec modification !

'---------------------------------
Private Sub CommandButton1_Click()

Dim Rst As New ADODB.Recordset
Dim Con As ADODB.Connection
Dim NbChamps As Integer
Dim NomFichier As String
Dim Arr As Variant, Nb As Long

'à définir le chemin et le nom de ton modèle
NomFichier = Application.TemplatesPath & "" & "0 Est Tecno Master
2005bon.xlt"
Set Con = New ADODB.Connection
Con.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & NomFichier
&
";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'modifie le nom de la feuille et l'adresse où se retrouve
'tes données dans ton modèle
Requete = "SELECT * From [Items$A31:L126]"
'Exécution de la requête
Rst.Open Requete, Con, adOpenStatic, adLockOptimistic
'Si le recordset n'est pas vide...
If Rst.EOF = False Then
Nb = Rst.RecordCount
Application.EnableEvents = False
Arr = Rst.GetRows
'Indique la première cellule de la colonne où doivent
'être copié les données, inclus dans la plage la cellule
'servant d'étiquette.
NbChamps = Rst.Fields.Count
Range("A31").Resize(Nb, NbChamps) = WorksheetFunction.Transpose(Arr)
Application.EnableEvents = True
Else
MsgBox "Aucune donnée disponible. Mise à jour impossible."
End If
'Ferme le recordset
Rst.Close: Con.Close
Set Rst = Nothing: Set Con = Nothing

End Sub
'---------------------------------

Sa fonctionne super bien mais le range
maximum que je peu mettre c'est
Requete = "SELECT * From [Items$A31:L126]"
et le range que je veut c'est au moin A31:L216 ...... et plus !!!
j'ai meme envi de mettre tout la page au complet car il va ce
rajouter des items sa ses sur et certain.
il me fait un erreur d'execution 13 !!! a la ligne
Range("A31").Resize(Nb, NbChamps) = WorksheetFunction.Transpose(Arr)
si je met un range trop grand :(

une autre solution ???
tk merci de ta patiente mais c'est juste ce detail qui me reste a regler

"michdenis" a écrit dans le message de news:

Bonjour Nicolas,

Tu crées dans ta feuille qui doit être mise à jour un bouton de commande
issu de la barre d'outils "contrôle" et tu copies dans
l'événement "Clic" la procédure suivante :

Pour exécuter cette macro, tu dois ajouter la référence suivante à ton
projet.

Ouvre VBE (visual basic editor), barre des menus / outils / référence /
et tu coches : "Microsoft Activex data objet 2.8 librairy"
si tu n'as pas 2.8, tu coches la plus récente...

Prend le temps de lire la macro, et d'apporter les correctifs pour
qu'elle
corresponde à ton application.

'---------------------------------
Private Sub CommandButton1_Click()

Dim Rst As New ADODB.Recordset
Dim Con As ADODB.Connection

Dim NomFichier As String
Dim Arr As Variant, Nb As Long

'à définir le chemin et le nom de ton modèle
NomFichier = ThisWorkbook.Path & "données.xls"

Set Con = New ADODB.Connection
Con.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & NomFichier & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

'modifie le nom de la feuille et l'adresse où se retrouve
'tes données dans ton modèle
Requete = "SELECT * From [Feuil1$B1:B10]"
'Exécution de la requête
Rst.Open Requete, Con, adOpenStatic, adLockOptimistic
'Si le recordset n'est pas vide...
If Rst.EOF = False Then
Nb = Rst.RecordCount
Application.EnableEvents = False
Arr = Rst.GetRows
'Indique la première cellule de la colonne où doivent
'être copié les données, inclus dans la plage la cellule
'servant d'étiquette.
Range("A1").Resize(Nb) = WorksheetFunction.Transpose(Arr)
Application.EnableEvents = True
Else
MsgBox "Aucune donnée disponible. Mise à jour impossible."
End If
'Ferme le recordset
Rst.Close: Con.Close
Set Rst = Nothing: Set Con = Nothing

End Sub
'---------------------------------




"Nicolas" a écrit dans le message de news:

ok dsl
j'ai des fichier excel (xls) qui son parreil comme mon modele xlt
dans le fond si je change le prix d''un item dans mon modele et que je
reeouvre un de mes fichier xls et bien j'ai un bouton qui fait une mise a
jour de ma liste d'item dans mon xls.
il copy tout la feuille item de mon modele et il la recolle dans ma
feuille
item de mon xls pour etre sur que je suis a jour dans mes prix !
mais tu me fais penser a sa et je pense que je me complique peut-etre la
vie
pour rien .... tk si ta une iddé propose et je ferrais :)

merci

"michdenis" a écrit dans le message de news:

Bonjour Nicolas,

Il manque quelque chose d'essentiel à ta question, Qu'est-ce que tu veux
faire ? Je ne veux pas que tu commentes ton code, je veux
simplement que tu m'expliques ce que tu tentes de réaliser.


Salutations!


"Nicolas" a écrit dans le message de news:

j'ai essayer ce que tu ma envoyer et sa fonctionne il ecrit le bon titre
dans la barre en haut "0 Est Tecno Master 2005eee.xlt"
mais le probleme c'est qu'il me bloque a la formule d'ensuite :(
voici mon codage sa peux peut-etre d'aider en tk moi je comprend pas
pourquoi qu'il ne fonctionne pas :(

If MsgBox("Vous etes sur le point de mettre a jour la liste d'item du
classeur " & ActiveWorkbook.Name & ". Êtes-vous sur de vouloir continuer
?",
vbYesNo) = vbNo Then
Exit Sub
Else
Nom = ActiveWorkbook.Name
Sheets("Items").Select
Rows("27:27").Select
ActiveWindow.FreezePanes = False
ActiveWindow.SmallScroll Down:=-36
Cells.Select
'Workbooks.Open "Z:ExcelgiEstimation Techno 2005 Est Tecno Master
2005eee.xlt" ' **** ANCIENNE COMMANDE POUR OUVRIR MON XLT ****
Call OuvrirUnModeleExcel ' **** LA NOUVELLE COMMANDE POUR OUVRIR MON
XLT
QUI FONCTIONNE #1 ****
' **** IL BLOQUE A L'ÉTAPE QUI SUIS !!! ****
Windows("0 Est Tecno Master 2005eee.xlt").Activate ' **** ERREUR
D'EXCUTION
'9' L'INDICE N'APPARTIEN PAS A LA SELECTION ****
Sheets("Items").Select
Rows("27:27").Select
ActiveWindow.FreezePanes = False
ActiveWindow.SmallScroll Down:=-45
Cells.Select
Selection.Copy
Range("A1").Select
Workbooks(Nom).Activate
Cells.Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
skipblanks: >>> _
False, Transpose:úlse
Range("A1").Select
ActiveWindow.SmallScroll Down:&
Range("A28").Select
ActiveWindow.FreezePanes = True
Application.CutCopyMode = False
Windows("0 Est Tecno Master 2005eee.xlt").Activate
ActiveWindow.Close (savechanges = False)
End If
End Sub

tk c'est compliquer mais bon si tu trouve pas je vais essayer de me
debrouiller autrement merci de ton aide.

"michdenis" a écrit dans le message de news:


Bonjour Nicolas,

Si tu désires ouvrir en utilisant VBA, un modèle excel comme modèle
(fichier xlt),

Tu peux utiliser ceci :

Copie ceci dans un module standard et assure toi de copier la
déclaration
des Api dans le haut de module avant toutes procédures.

'Api pour la commande ShellExecute
Private Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal Hwnd As Long, ByVal lpszOp As _
String, ByVal lpszFile As String, ByVal lpszParams As String, _
ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long

'Api pour déterminer le Hwnd (handle de la fenêtre)
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'----------------------------------------
Sub OuvrirUnModeleExcel()

'ouvrir un modèle excel comme fichier xlt
'pour pouvoir le modifier

Const SW_SHOWNORMAL = 1
Dim Hwnd As Long
Dim Fich As String

'Adapter le chemin et le nom du modèle selon vos désirs
Fich = Application.TemplatesPath & "" & "Feuille.xlt"

'Test pour valider si le fichier existe ...
If Dir(Fich) <> "" Then
Hwnd = FindWindow(vbNullString, Application.Caption)
ShellExecute Hwnd, "open", Fich, vbNullString, vbNullString,
SW_SHOWNORMAL
Else
MsgBox "Fichier ou chemin inexistant"
End If
End Sub
'----------------------------------------


Salutations!


"Nicolas" a écrit dans le message de news:

moi dans ma barre en haut j'ai pas l'extention du .xlt
dans ma macro plus haut je l'ouvre de cette facon
Workbooks.Open "S:ExcelgiEstimation Techno 2005 Est Tecno Master
2005eee.xlt"
mais dans la barre en haut c'est marquer comme sa
0 Est Tecno Master 2005eee1

pis si je l'ouvre normalement (sans la macro) avec fichier.....ouvrir
et
bien le nom est corrcet dans le haut 0 Est Tecno Master 2005eee.xlt
bizzzz

je croi que ses a cause de sa qu'il me demande d'enregister sous meme
si
il
est a false !

merci


"michdenis" a écrit dans le message de news:

Bonjour Nicolas,

J'ai testé ceci sous excel 2003

Le document Feuille.xlt est ouvert comme modèle... dans la barre de
titre
son nom est complet et l'extension .xlt est visible.
Est-ce ton cas ? Ou est-ce que ton fichier n'a pas d'extension ...
parce
qu'alors il n'est pas ouvert à titre de modèle mais comme
futur classeur .xls.

Windows("Feuille.xlt").Activate
ActiveWindow.Close (savechanges = False)

Aucun problème avec des 2 lignes de code.


Salutations!




"Nicolas" a écrit dans le message de news:
%
J'ai la macro suivante

Windows("0 Est Tecno Master 2005eee1").Activate
ActiveWindow.Close (savechanges = False)

qui est supposer fermer mon fichier 0 Est Tecno Master 2005eee1 (qui
est
un
model .xlt) sans me demander de sauvegarder mais il m'apparait quand
meme
une fenetre de sauvegarder sous .....

ya quelqu'un qui a une iddée pk ? et si je met mon extension .xlt
comme
sa

Windows("0 Est Tecno Master 2005eee1.xlt").Activate
ActiveWindow.Close (savechanges = False)

et bien il ne le trouve pas !

mais si je le met en xls

Windows("0 Est Tecno Master 2005eee1.xls").Activate
ActiveWindow.Close (savechanges = False)

tout ferme comme il faut et tout fonctionne #1

bizzard non ?

merce d'avance de votre aide

























1 2