Bonjour Pascal,
Voici le code incriminé!
Merci pour ton aide
Sub ImportationExcel_3c()
'Dans Art Gr DT Bis.mpp
Dim XLApp As Excel.Application 'La référence par variable à liaison
précoce offre de meilleures performances, mais ne peut contenir qu'une
référence à la classe indiquée dans la déclaration.
Dim Chemin As String, Clic As Integer
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
'Application.ScreenUpdating = False 'Fige l'affichage écran
'Set XLApp = New Excel.Application 'Exige une Référence sur une version
d'Excel
Set XLApp = CreateObject("Excel.Application") 'Va chercher le Excel qui
figure dans la Base de registre, quelque soit sa version,
'mais ne présente plus d'aide à la synthaxe.
XLApp.Visible = False
'ChDrive "D" '"D:Mes documentsDT a traiter"
'Chemin = "D:Mes documentsDT a traiter" 'Inutile avec la boîte de
dialogue msoFileDialogFilePicker
'ChDir Chemin 'Modifie le répertoire par
défaut
'NB : La boîte de dialogue msoFileDialogFilePicker n'utilise pas le
dossier par défaut,
'mais ce qui est spécifié dans Excel comme répertoire de démarrage
'NomClasseurXL = InputBox("Nom du classeur Excel :", "Importation des
données Excel", "Demande Opération 1.xls")
Dim oDialog As Office.FileDialog 'Create a
FileDialog object
'Create a FileDialog object as a File Picker dialog box:
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker) 'Ouvre une
boîte de dialogue MS Office FilePicker : 'Create a FileDialog object as a
File Picker dialog box.
oDialog.InitialFileName = "D:Mes documentsDT a traiter" 'Set the
initial path to the D: drive.
oDialog.Filters.Add "Fichiers Excel", "*.xls" 'Sélection
sur les classeurs .XLS
oDialog.Title = "Sélectionnez le fichier Excel" 'Titre de
la boîte de dialogue
oDialog.AllowMultiSelect = False 'Pas de
sélection multiple
If oDialog.Show = 0 Then 'Affiche la boîte de dialogue MS Office
FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'MsgBox "Le classeur Excel sélectionné est : " & NomClasseurXL
'Empêche la fermeture de la fenêtre Excel
End If
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à
partir d'Excel"
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub
End If
Set oDialog = Nothing
If NomClasseurXL = "" Then 'Si l'opérateur n'a rien
sélectionné
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub 'on quitte la procédure
End If
XLApp.WorkBooks.Open NomClasseurXL
XLApp.Visible = False
With XLApp
'.Workbooks.Open FileName:=NomClasseurXL 'Ouvre le Classeur voulu
'MsgBox "Erreur N° : " & Err.Number & " " & Err.Description 'Erreurs
récupérables
If Err.Number = 1004 Then 'Fichier n'existe pas
MsgBox "Erreur sur le nom du classeur Excel ou sur le chemin
d'accès"
Exit Sub
End If
'.WindowState = xlMinimized 'Réduit la fenêtre XL
(mais la réaffiche)
.Visible = False 'True 'Fenêtre invisible/visible
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
Clic = MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import des
données Excel")
If Clic = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
NomTache = .Range("DTimpr!MSPTache").Rows(1).Value 'Lit le
champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=NomTache, TaskID:=1 'Dépose le
nom de la tâche qui figure dans le champ "DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1 'EnterpriseTaskOutlineCode1
End With
'Application.ScreenUpdating = True
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
XLApp.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur sans
sauvegarde !
XLApp.Quit
Set XLApp = Nothing
End Sub
Bonjour Pascal,
Voici le code incriminé!
Merci pour ton aide
Sub ImportationExcel_3c()
'Dans Art Gr DT Bis.mpp
Dim XLApp As Excel.Application 'La référence par variable à liaison
précoce offre de meilleures performances, mais ne peut contenir qu'une
référence à la classe indiquée dans la déclaration.
Dim Chemin As String, Clic As Integer
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
'Application.ScreenUpdating = False 'Fige l'affichage écran
'Set XLApp = New Excel.Application 'Exige une Référence sur une version
d'Excel
Set XLApp = CreateObject("Excel.Application") 'Va chercher le Excel qui
figure dans la Base de registre, quelque soit sa version,
'mais ne présente plus d'aide à la synthaxe.
XLApp.Visible = False
'ChDrive "D" '"D:Mes documentsDT a traiter"
'Chemin = "D:Mes documentsDT a traiter" 'Inutile avec la boîte de
dialogue msoFileDialogFilePicker
'ChDir Chemin 'Modifie le répertoire par
défaut
'NB : La boîte de dialogue msoFileDialogFilePicker n'utilise pas le
dossier par défaut,
'mais ce qui est spécifié dans Excel comme répertoire de démarrage
'NomClasseurXL = InputBox("Nom du classeur Excel :", "Importation des
données Excel", "Demande Opération 1.xls")
Dim oDialog As Office.FileDialog 'Create a
FileDialog object
'Create a FileDialog object as a File Picker dialog box:
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker) 'Ouvre une
boîte de dialogue MS Office FilePicker : 'Create a FileDialog object as a
File Picker dialog box.
oDialog.InitialFileName = "D:Mes documentsDT a traiter" 'Set the
initial path to the D: drive.
oDialog.Filters.Add "Fichiers Excel", "*.xls" 'Sélection
sur les classeurs .XLS
oDialog.Title = "Sélectionnez le fichier Excel" 'Titre de
la boîte de dialogue
oDialog.AllowMultiSelect = False 'Pas de
sélection multiple
If oDialog.Show = 0 Then 'Affiche la boîte de dialogue MS Office
FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'MsgBox "Le classeur Excel sélectionné est : " & NomClasseurXL
'Empêche la fermeture de la fenêtre Excel
End If
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à
partir d'Excel"
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub
End If
Set oDialog = Nothing
If NomClasseurXL = "" Then 'Si l'opérateur n'a rien
sélectionné
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub 'on quitte la procédure
End If
XLApp.WorkBooks.Open NomClasseurXL
XLApp.Visible = False
With XLApp
'.Workbooks.Open FileName:=NomClasseurXL 'Ouvre le Classeur voulu
'MsgBox "Erreur N° : " & Err.Number & " " & Err.Description 'Erreurs
récupérables
If Err.Number = 1004 Then 'Fichier n'existe pas
MsgBox "Erreur sur le nom du classeur Excel ou sur le chemin
d'accès"
Exit Sub
End If
'.WindowState = xlMinimized 'Réduit la fenêtre XL
(mais la réaffiche)
.Visible = False 'True 'Fenêtre invisible/visible
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
Clic = MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import des
données Excel")
If Clic = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
NomTache = .Range("DTimpr!MSPTache").Rows(1).Value 'Lit le
champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=NomTache, TaskID:=1 'Dépose le
nom de la tâche qui figure dans le champ "DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1 'EnterpriseTaskOutlineCode1
End With
'Application.ScreenUpdating = True
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
XLApp.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur sans
sauvegarde !
XLApp.Quit
Set XLApp = Nothing
End Sub
Bonjour Pascal,
Voici le code incriminé!
Merci pour ton aide
Sub ImportationExcel_3c()
'Dans Art Gr DT Bis.mpp
Dim XLApp As Excel.Application 'La référence par variable à liaison
précoce offre de meilleures performances, mais ne peut contenir qu'une
référence à la classe indiquée dans la déclaration.
Dim Chemin As String, Clic As Integer
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
'Application.ScreenUpdating = False 'Fige l'affichage écran
'Set XLApp = New Excel.Application 'Exige une Référence sur une version
d'Excel
Set XLApp = CreateObject("Excel.Application") 'Va chercher le Excel qui
figure dans la Base de registre, quelque soit sa version,
'mais ne présente plus d'aide à la synthaxe.
XLApp.Visible = False
'ChDrive "D" '"D:Mes documentsDT a traiter"
'Chemin = "D:Mes documentsDT a traiter" 'Inutile avec la boîte de
dialogue msoFileDialogFilePicker
'ChDir Chemin 'Modifie le répertoire par
défaut
'NB : La boîte de dialogue msoFileDialogFilePicker n'utilise pas le
dossier par défaut,
'mais ce qui est spécifié dans Excel comme répertoire de démarrage
'NomClasseurXL = InputBox("Nom du classeur Excel :", "Importation des
données Excel", "Demande Opération 1.xls")
Dim oDialog As Office.FileDialog 'Create a
FileDialog object
'Create a FileDialog object as a File Picker dialog box:
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker) 'Ouvre une
boîte de dialogue MS Office FilePicker : 'Create a FileDialog object as a
File Picker dialog box.
oDialog.InitialFileName = "D:Mes documentsDT a traiter" 'Set the
initial path to the D: drive.
oDialog.Filters.Add "Fichiers Excel", "*.xls" 'Sélection
sur les classeurs .XLS
oDialog.Title = "Sélectionnez le fichier Excel" 'Titre de
la boîte de dialogue
oDialog.AllowMultiSelect = False 'Pas de
sélection multiple
If oDialog.Show = 0 Then 'Affiche la boîte de dialogue MS Office
FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'MsgBox "Le classeur Excel sélectionné est : " & NomClasseurXL
'Empêche la fermeture de la fenêtre Excel
End If
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à
partir d'Excel"
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub
End If
Set oDialog = Nothing
If NomClasseurXL = "" Then 'Si l'opérateur n'a rien
sélectionné
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub 'on quitte la procédure
End If
XLApp.WorkBooks.Open NomClasseurXL
XLApp.Visible = False
With XLApp
'.Workbooks.Open FileName:=NomClasseurXL 'Ouvre le Classeur voulu
'MsgBox "Erreur N° : " & Err.Number & " " & Err.Description 'Erreurs
récupérables
If Err.Number = 1004 Then 'Fichier n'existe pas
MsgBox "Erreur sur le nom du classeur Excel ou sur le chemin
d'accès"
Exit Sub
End If
'.WindowState = xlMinimized 'Réduit la fenêtre XL
(mais la réaffiche)
.Visible = False 'True 'Fenêtre invisible/visible
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
Clic = MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import des
données Excel")
If Clic = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
NomTache = .Range("DTimpr!MSPTache").Rows(1).Value 'Lit le
champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=NomTache, TaskID:=1 'Dépose le
nom de la tâche qui figure dans le champ "DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1 'EnterpriseTaskOutlineCode1
End With
'Application.ScreenUpdating = True
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
XLApp.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur sans
sauvegarde !
XLApp.Quit
Set XLApp = Nothing
End Sub
Woody
Vite fait comme ça quelques problèmes :
1°) Dim xlApp As Excel.Application
Tu dois faire un choix (je crois d'ailleurs que je t'en avais déjà touché
un mot) :
Soit
Tu conserves ta déclaration telle quelle, alors tu dois utiliser la
méthode
Set XLApp = New Excel.Application
Où
Si tu utilises la méthode
Set XLApp = CreateObject("Excel.Application")
Alors tu modifies ta déclaration :
Dim xlApp As Object
2°) Ensuite :
If oDialog.Show = 0 Then
'Affiche la boîte de dialogue MS Office FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
Tu n'as pas bien noté mon explication d'hier :
*** La méthode oDialog.Show renvoie 0 (zéro) si l'opération a été annulée
***
Hors dans ton code tu continues, il faut donc que tu positionnes l'arrêt
de ta procédure à ce niveau :
If oDialog.Show = 0 Then
Msgbox "Opération annulée", vbExclamation, "Pas d'importation à partir d
'Excel"
xlApp.Quit
Set xlApp = Nothing
Exit sub
Else
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'ensuite tu positionnes le reste de tes opérations ici
'et tu n'oublies pas de positionner à la fin :
End If
3°) If NomClasseurXL = "" Then
Ceci n'a pas d'intérêt puisque tu effectues déjà ton contrôle auparavant
avec If oDialog.Show = 0
4°) Je vois d'autres choses et plus particulièrement je te conseillerai de
travailler sur une gestion d'erreur globale (même si tu évoques un If
Err.Number = 1004 qui ne me paraît pas nécessaire - tu as déjà fait ton
contrôle précédement ! et de toute façon c'est mal positionné)
Sinon, tu répètes dans ton code l'affectation de la propriété Visible à
False pour XLApp, ça me paraît inutile (dans la partie commençant par With
XLApp).
Je ne peux pas tester ta procédure pour la suite, je ne possède pas
MSProject, mais tu devrais avancer un peu quand même avec ces suggestions.
Cordialement
Pascal
"Woody" a écrit dans le message de news:Bonjour Pascal,
Voici le code incriminé!
Merci pour ton aide
Sub ImportationExcel_3c()
'Dans Art Gr DT Bis.mpp
Dim XLApp As Excel.Application 'La référence par variable à liaison
précoce offre de meilleures performances, mais ne peut contenir qu'une
référence à la classe indiquée dans la déclaration.
Dim Chemin As String, Clic As Integer
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
'Application.ScreenUpdating = False 'Fige l'affichage écran
'Set XLApp = New Excel.Application 'Exige une Référence sur une version
d'Excel
Set XLApp = CreateObject("Excel.Application") 'Va chercher le Excel qui
figure dans la Base de registre, quelque soit sa version,
'mais ne présente plus d'aide à la synthaxe.
XLApp.Visible = False
'ChDrive "D" '"D:Mes documentsDT a traiter"
'Chemin = "D:Mes documentsDT a traiter" 'Inutile avec la boîte de
dialogue msoFileDialogFilePicker
'ChDir Chemin 'Modifie le répertoire par
défaut
'NB : La boîte de dialogue msoFileDialogFilePicker n'utilise pas le
dossier par défaut,
'mais ce qui est spécifié dans Excel comme répertoire de démarrage
'NomClasseurXL = InputBox("Nom du classeur Excel :", "Importation des
données Excel", "Demande Opération 1.xls")
Dim oDialog As Office.FileDialog 'Create a
FileDialog object
'Create a FileDialog object as a File Picker dialog box:
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker) 'Ouvre une
boîte de dialogue MS Office FilePicker : 'Create a FileDialog object as a
File Picker dialog box.
oDialog.InitialFileName = "D:Mes documentsDT a traiter" 'Set the
initial path to the D: drive.
oDialog.Filters.Add "Fichiers Excel", "*.xls" 'Sélection
sur les classeurs .XLS
oDialog.Title = "Sélectionnez le fichier Excel" 'Titre de
la boîte de dialogue
oDialog.AllowMultiSelect = False 'Pas de
sélection multiple
If oDialog.Show = 0 Then 'Affiche la boîte de dialogue MS Office
FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'MsgBox "Le classeur Excel sélectionné est : " & NomClasseurXL
'Empêche la fermeture de la fenêtre Excel
End If
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à
partir d'Excel"
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub
End If
Set oDialog = Nothing
If NomClasseurXL = "" Then 'Si l'opérateur n'a rien
sélectionné
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub 'on quitte la procédure
End If
XLApp.WorkBooks.Open NomClasseurXL
XLApp.Visible = False
With XLApp
'.Workbooks.Open FileName:=NomClasseurXL 'Ouvre le Classeur voulu
'MsgBox "Erreur N° : " & Err.Number & " " & Err.Description 'Erreurs
récupérables
If Err.Number = 1004 Then 'Fichier n'existe pas
MsgBox "Erreur sur le nom du classeur Excel ou sur le chemin
d'accès"
Exit Sub
End If
'.WindowState = xlMinimized 'Réduit la fenêtre XL
(mais la réaffiche)
.Visible = False 'True 'Fenêtre invisible/visible
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
Clic = MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import
des données Excel")
If Clic = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
NomTache = .Range("DTimpr!MSPTache").Rows(1).Value 'Lit le
champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=NomTache, TaskID:=1 'Dépose le
nom de la tâche qui figure dans le champ "DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1 'EnterpriseTaskOutlineCode1
End With
'Application.ScreenUpdating = True
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
XLApp.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur sans
sauvegarde !
XLApp.Quit
Set XLApp = Nothing
End Sub
Woody
Vite fait comme ça quelques problèmes :
1°) Dim xlApp As Excel.Application
Tu dois faire un choix (je crois d'ailleurs que je t'en avais déjà touché
un mot) :
Soit
Tu conserves ta déclaration telle quelle, alors tu dois utiliser la
méthode
Set XLApp = New Excel.Application
Où
Si tu utilises la méthode
Set XLApp = CreateObject("Excel.Application")
Alors tu modifies ta déclaration :
Dim xlApp As Object
2°) Ensuite :
If oDialog.Show = 0 Then
'Affiche la boîte de dialogue MS Office FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
Tu n'as pas bien noté mon explication d'hier :
*** La méthode oDialog.Show renvoie 0 (zéro) si l'opération a été annulée
***
Hors dans ton code tu continues, il faut donc que tu positionnes l'arrêt
de ta procédure à ce niveau :
If oDialog.Show = 0 Then
Msgbox "Opération annulée", vbExclamation, "Pas d'importation à partir d
'Excel"
xlApp.Quit
Set xlApp = Nothing
Exit sub
Else
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'ensuite tu positionnes le reste de tes opérations ici
'et tu n'oublies pas de positionner à la fin :
End If
3°) If NomClasseurXL = "" Then
Ceci n'a pas d'intérêt puisque tu effectues déjà ton contrôle auparavant
avec If oDialog.Show = 0
4°) Je vois d'autres choses et plus particulièrement je te conseillerai de
travailler sur une gestion d'erreur globale (même si tu évoques un If
Err.Number = 1004 qui ne me paraît pas nécessaire - tu as déjà fait ton
contrôle précédement ! et de toute façon c'est mal positionné)
Sinon, tu répètes dans ton code l'affectation de la propriété Visible à
False pour XLApp, ça me paraît inutile (dans la partie commençant par With
XLApp).
Je ne peux pas tester ta procédure pour la suite, je ne possède pas
MSProject, mais tu devrais avancer un peu quand même avec ces suggestions.
Cordialement
Pascal
"Woody" <Woody@blackwood.net.invalid> a écrit dans le message de news:
eEbMZPWFIHA.1212@TK2MSFTNGP05.phx.gbl...
Bonjour Pascal,
Voici le code incriminé!
Merci pour ton aide
Sub ImportationExcel_3c()
'Dans Art Gr DT Bis.mpp
Dim XLApp As Excel.Application 'La référence par variable à liaison
précoce offre de meilleures performances, mais ne peut contenir qu'une
référence à la classe indiquée dans la déclaration.
Dim Chemin As String, Clic As Integer
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
'Application.ScreenUpdating = False 'Fige l'affichage écran
'Set XLApp = New Excel.Application 'Exige une Référence sur une version
d'Excel
Set XLApp = CreateObject("Excel.Application") 'Va chercher le Excel qui
figure dans la Base de registre, quelque soit sa version,
'mais ne présente plus d'aide à la synthaxe.
XLApp.Visible = False
'ChDrive "D" '"D:Mes documentsDT a traiter"
'Chemin = "D:Mes documentsDT a traiter" 'Inutile avec la boîte de
dialogue msoFileDialogFilePicker
'ChDir Chemin 'Modifie le répertoire par
défaut
'NB : La boîte de dialogue msoFileDialogFilePicker n'utilise pas le
dossier par défaut,
'mais ce qui est spécifié dans Excel comme répertoire de démarrage
'NomClasseurXL = InputBox("Nom du classeur Excel :", "Importation des
données Excel", "Demande Opération 1.xls")
Dim oDialog As Office.FileDialog 'Create a
FileDialog object
'Create a FileDialog object as a File Picker dialog box:
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker) 'Ouvre une
boîte de dialogue MS Office FilePicker : 'Create a FileDialog object as a
File Picker dialog box.
oDialog.InitialFileName = "D:Mes documentsDT a traiter" 'Set the
initial path to the D: drive.
oDialog.Filters.Add "Fichiers Excel", "*.xls" 'Sélection
sur les classeurs .XLS
oDialog.Title = "Sélectionnez le fichier Excel" 'Titre de
la boîte de dialogue
oDialog.AllowMultiSelect = False 'Pas de
sélection multiple
If oDialog.Show = 0 Then 'Affiche la boîte de dialogue MS Office
FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'MsgBox "Le classeur Excel sélectionné est : " & NomClasseurXL
'Empêche la fermeture de la fenêtre Excel
End If
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à
partir d'Excel"
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub
End If
Set oDialog = Nothing
If NomClasseurXL = "" Then 'Si l'opérateur n'a rien
sélectionné
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub 'on quitte la procédure
End If
XLApp.WorkBooks.Open NomClasseurXL
XLApp.Visible = False
With XLApp
'.Workbooks.Open FileName:=NomClasseurXL 'Ouvre le Classeur voulu
'MsgBox "Erreur N° : " & Err.Number & " " & Err.Description 'Erreurs
récupérables
If Err.Number = 1004 Then 'Fichier n'existe pas
MsgBox "Erreur sur le nom du classeur Excel ou sur le chemin
d'accès"
Exit Sub
End If
'.WindowState = xlMinimized 'Réduit la fenêtre XL
(mais la réaffiche)
.Visible = False 'True 'Fenêtre invisible/visible
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
Clic = MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import
des données Excel")
If Clic = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
NomTache = .Range("DTimpr!MSPTache").Rows(1).Value 'Lit le
champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=NomTache, TaskID:=1 'Dépose le
nom de la tâche qui figure dans le champ "DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1 'EnterpriseTaskOutlineCode1
End With
'Application.ScreenUpdating = True
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
XLApp.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur sans
sauvegarde !
XLApp.Quit
Set XLApp = Nothing
End Sub
Woody
Vite fait comme ça quelques problèmes :
1°) Dim xlApp As Excel.Application
Tu dois faire un choix (je crois d'ailleurs que je t'en avais déjà touché
un mot) :
Soit
Tu conserves ta déclaration telle quelle, alors tu dois utiliser la
méthode
Set XLApp = New Excel.Application
Où
Si tu utilises la méthode
Set XLApp = CreateObject("Excel.Application")
Alors tu modifies ta déclaration :
Dim xlApp As Object
2°) Ensuite :
If oDialog.Show = 0 Then
'Affiche la boîte de dialogue MS Office FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
Tu n'as pas bien noté mon explication d'hier :
*** La méthode oDialog.Show renvoie 0 (zéro) si l'opération a été annulée
***
Hors dans ton code tu continues, il faut donc que tu positionnes l'arrêt
de ta procédure à ce niveau :
If oDialog.Show = 0 Then
Msgbox "Opération annulée", vbExclamation, "Pas d'importation à partir d
'Excel"
xlApp.Quit
Set xlApp = Nothing
Exit sub
Else
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'ensuite tu positionnes le reste de tes opérations ici
'et tu n'oublies pas de positionner à la fin :
End If
3°) If NomClasseurXL = "" Then
Ceci n'a pas d'intérêt puisque tu effectues déjà ton contrôle auparavant
avec If oDialog.Show = 0
4°) Je vois d'autres choses et plus particulièrement je te conseillerai de
travailler sur une gestion d'erreur globale (même si tu évoques un If
Err.Number = 1004 qui ne me paraît pas nécessaire - tu as déjà fait ton
contrôle précédement ! et de toute façon c'est mal positionné)
Sinon, tu répètes dans ton code l'affectation de la propriété Visible à
False pour XLApp, ça me paraît inutile (dans la partie commençant par With
XLApp).
Je ne peux pas tester ta procédure pour la suite, je ne possède pas
MSProject, mais tu devrais avancer un peu quand même avec ces suggestions.
Cordialement
Pascal
"Woody" a écrit dans le message de news:Bonjour Pascal,
Voici le code incriminé!
Merci pour ton aide
Sub ImportationExcel_3c()
'Dans Art Gr DT Bis.mpp
Dim XLApp As Excel.Application 'La référence par variable à liaison
précoce offre de meilleures performances, mais ne peut contenir qu'une
référence à la classe indiquée dans la déclaration.
Dim Chemin As String, Clic As Integer
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
'Application.ScreenUpdating = False 'Fige l'affichage écran
'Set XLApp = New Excel.Application 'Exige une Référence sur une version
d'Excel
Set XLApp = CreateObject("Excel.Application") 'Va chercher le Excel qui
figure dans la Base de registre, quelque soit sa version,
'mais ne présente plus d'aide à la synthaxe.
XLApp.Visible = False
'ChDrive "D" '"D:Mes documentsDT a traiter"
'Chemin = "D:Mes documentsDT a traiter" 'Inutile avec la boîte de
dialogue msoFileDialogFilePicker
'ChDir Chemin 'Modifie le répertoire par
défaut
'NB : La boîte de dialogue msoFileDialogFilePicker n'utilise pas le
dossier par défaut,
'mais ce qui est spécifié dans Excel comme répertoire de démarrage
'NomClasseurXL = InputBox("Nom du classeur Excel :", "Importation des
données Excel", "Demande Opération 1.xls")
Dim oDialog As Office.FileDialog 'Create a
FileDialog object
'Create a FileDialog object as a File Picker dialog box:
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker) 'Ouvre une
boîte de dialogue MS Office FilePicker : 'Create a FileDialog object as a
File Picker dialog box.
oDialog.InitialFileName = "D:Mes documentsDT a traiter" 'Set the
initial path to the D: drive.
oDialog.Filters.Add "Fichiers Excel", "*.xls" 'Sélection
sur les classeurs .XLS
oDialog.Title = "Sélectionnez le fichier Excel" 'Titre de
la boîte de dialogue
oDialog.AllowMultiSelect = False 'Pas de
sélection multiple
If oDialog.Show = 0 Then 'Affiche la boîte de dialogue MS Office
FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'MsgBox "Le classeur Excel sélectionné est : " & NomClasseurXL
'Empêche la fermeture de la fenêtre Excel
End If
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à
partir d'Excel"
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub
End If
Set oDialog = Nothing
If NomClasseurXL = "" Then 'Si l'opérateur n'a rien
sélectionné
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub 'on quitte la procédure
End If
XLApp.WorkBooks.Open NomClasseurXL
XLApp.Visible = False
With XLApp
'.Workbooks.Open FileName:=NomClasseurXL 'Ouvre le Classeur voulu
'MsgBox "Erreur N° : " & Err.Number & " " & Err.Description 'Erreurs
récupérables
If Err.Number = 1004 Then 'Fichier n'existe pas
MsgBox "Erreur sur le nom du classeur Excel ou sur le chemin
d'accès"
Exit Sub
End If
'.WindowState = xlMinimized 'Réduit la fenêtre XL
(mais la réaffiche)
.Visible = False 'True 'Fenêtre invisible/visible
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
Clic = MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import
des données Excel")
If Clic = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
NomTache = .Range("DTimpr!MSPTache").Rows(1).Value 'Lit le
champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=NomTache, TaskID:=1 'Dépose le
nom de la tâche qui figure dans le champ "DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1 'EnterpriseTaskOutlineCode1
End With
'Application.ScreenUpdating = True
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
XLApp.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur sans
sauvegarde !
XLApp.Quit
Set XLApp = Nothing
End Sub
Pascal,
Merci pour tout ce travail de correction !
Je me suis appliqué à effectuer toutes les corrections suggérées (sauf la
gestion d'erreur globale que je n'ai pas encore faite). La procédure
fonctionne mais avec les deux inconvénients qui incriminent l'efficacité
du XLApp.Visible = False
- Si je clique OK dans la boite de dialog msoFileDialogFilePicker, la
fenêtre Excel apparaît une seconde puis disparaît. Le reste se passe bien.
- Si je clique Annuler, la fenêtre Excel (vide) reste figée à l'écran. Je
dois la fermer manuellement pour accéder au
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à partir
d'Excel". Ensuite tout se passe normalement.
Quelque idée ?
Merci encore,
Woody
"papou" a écrit dans le
message de news:Woody
Vite fait comme ça quelques problèmes :
1°) Dim xlApp As Excel.Application
Tu dois faire un choix (je crois d'ailleurs que je t'en avais déjà touché
un mot) :
Soit
Tu conserves ta déclaration telle quelle, alors tu dois utiliser la
méthode
Set XLApp = New Excel.Application
Où
Si tu utilises la méthode
Set XLApp = CreateObject("Excel.Application")
Alors tu modifies ta déclaration :
Dim xlApp As Object
2°) Ensuite :
If oDialog.Show = 0 Then
'Affiche la boîte de dialogue MS Office FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
Tu n'as pas bien noté mon explication d'hier :
*** La méthode oDialog.Show renvoie 0 (zéro) si l'opération a été annulée
***
Hors dans ton code tu continues, il faut donc que tu positionnes l'arrêt
de ta procédure à ce niveau :
If oDialog.Show = 0 Then
Msgbox "Opération annulée", vbExclamation, "Pas d'importation à partir d
'Excel"
xlApp.Quit
Set xlApp = Nothing
Exit sub
Else
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'ensuite tu positionnes le reste de tes opérations ici
'et tu n'oublies pas de positionner à la fin :
End If
3°) If NomClasseurXL = "" Then
Ceci n'a pas d'intérêt puisque tu effectues déjà ton contrôle auparavant
avec If oDialog.Show = 0
4°) Je vois d'autres choses et plus particulièrement je te conseillerai
de travailler sur une gestion d'erreur globale (même si tu évoques un If
Err.Number = 1004 qui ne me paraît pas nécessaire - tu as déjà fait ton
contrôle précédement ! et de toute façon c'est mal positionné)
Sinon, tu répètes dans ton code l'affectation de la propriété Visible à
False pour XLApp, ça me paraît inutile (dans la partie commençant par
With XLApp).
Je ne peux pas tester ta procédure pour la suite, je ne possède pas
MSProject, mais tu devrais avancer un peu quand même avec ces
suggestions.
Cordialement
Pascal
"Woody" a écrit dans le message de news:Bonjour Pascal,
Voici le code incriminé!
Merci pour ton aide
Sub ImportationExcel_3c()
'Dans Art Gr DT Bis.mpp
Dim XLApp As Excel.Application 'La référence par variable à liaison
précoce offre de meilleures performances, mais ne peut contenir qu'une
référence à la classe indiquée dans la déclaration.
Dim Chemin As String, Clic As Integer
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
'Application.ScreenUpdating = False 'Fige l'affichage écran
'Set XLApp = New Excel.Application 'Exige une Référence sur une version
d'Excel
Set XLApp = CreateObject("Excel.Application") 'Va chercher le Excel qui
figure dans la Base de registre, quelque soit sa version,
'mais ne présente plus d'aide à la synthaxe.
XLApp.Visible = False
'ChDrive "D" '"D:Mes documentsDT a traiter"
'Chemin = "D:Mes documentsDT a traiter" 'Inutile avec la boîte de
dialogue msoFileDialogFilePicker
'ChDir Chemin 'Modifie le répertoire par
défaut
'NB : La boîte de dialogue msoFileDialogFilePicker n'utilise pas le
dossier par défaut,
'mais ce qui est spécifié dans Excel comme répertoire de démarrage
'NomClasseurXL = InputBox("Nom du classeur Excel :", "Importation des
données Excel", "Demande Opération 1.xls")
Dim oDialog As Office.FileDialog 'Create a
FileDialog object
'Create a FileDialog object as a File Picker dialog box:
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker) 'Ouvre
une boîte de dialogue MS Office FilePicker : 'Create a FileDialog object
as a File Picker dialog box.
oDialog.InitialFileName = "D:Mes documentsDT a traiter" 'Set the
initial path to the D: drive.
oDialog.Filters.Add "Fichiers Excel", "*.xls"
'Sélection sur les classeurs .XLS
oDialog.Title = "Sélectionnez le fichier Excel" 'Titre de
la boîte de dialogue
oDialog.AllowMultiSelect = False 'Pas de
sélection multiple
If oDialog.Show = 0 Then 'Affiche la boîte de dialogue MS Office
FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'MsgBox "Le classeur Excel sélectionné est : " &
NomClasseurXL 'Empêche la fermeture de la fenêtre Excel
End If
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à
partir d'Excel"
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub
End If
Set oDialog = Nothing
If NomClasseurXL = "" Then 'Si l'opérateur n'a rien
sélectionné
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub 'on quitte la procédure
End If
XLApp.WorkBooks.Open NomClasseurXL
XLApp.Visible = False
With XLApp
'.Workbooks.Open FileName:=NomClasseurXL 'Ouvre le Classeur
voulu
'MsgBox "Erreur N° : " & Err.Number & " " & Err.Description
'Erreurs récupérables
If Err.Number = 1004 Then 'Fichier n'existe pas
MsgBox "Erreur sur le nom du classeur Excel ou sur le chemin
d'accès"
Exit Sub
End If
'.WindowState = xlMinimized 'Réduit la fenêtre XL
(mais la réaffiche)
.Visible = False 'True 'Fenêtre
invisible/visible
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
Clic = MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import
des données Excel")
If Clic = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
NomTache = .Range("DTimpr!MSPTache").Rows(1).Value 'Lit le
champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=NomTache, TaskID:=1 'Dépose
le nom de la tâche qui figure dans le champ "DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
'EnterpriseTaskOutlineCode1
End With
'Application.ScreenUpdating = True
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
XLApp.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur
sans sauvegarde !
XLApp.Quit
Set XLApp = Nothing
End Sub
Pascal,
Merci pour tout ce travail de correction !
Je me suis appliqué à effectuer toutes les corrections suggérées (sauf la
gestion d'erreur globale que je n'ai pas encore faite). La procédure
fonctionne mais avec les deux inconvénients qui incriminent l'efficacité
du XLApp.Visible = False
- Si je clique OK dans la boite de dialog msoFileDialogFilePicker, la
fenêtre Excel apparaît une seconde puis disparaît. Le reste se passe bien.
- Si je clique Annuler, la fenêtre Excel (vide) reste figée à l'écran. Je
dois la fermer manuellement pour accéder au
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à partir
d'Excel". Ensuite tout se passe normalement.
Quelque idée ?
Merci encore,
Woody
"papou" <cpapounospamthanx@laposte.netnospamthanks> a écrit dans le
message de news: OnpkesWFIHA.5228@TK2MSFTNGP05.phx.gbl...
Woody
Vite fait comme ça quelques problèmes :
1°) Dim xlApp As Excel.Application
Tu dois faire un choix (je crois d'ailleurs que je t'en avais déjà touché
un mot) :
Soit
Tu conserves ta déclaration telle quelle, alors tu dois utiliser la
méthode
Set XLApp = New Excel.Application
Où
Si tu utilises la méthode
Set XLApp = CreateObject("Excel.Application")
Alors tu modifies ta déclaration :
Dim xlApp As Object
2°) Ensuite :
If oDialog.Show = 0 Then
'Affiche la boîte de dialogue MS Office FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
Tu n'as pas bien noté mon explication d'hier :
*** La méthode oDialog.Show renvoie 0 (zéro) si l'opération a été annulée
***
Hors dans ton code tu continues, il faut donc que tu positionnes l'arrêt
de ta procédure à ce niveau :
If oDialog.Show = 0 Then
Msgbox "Opération annulée", vbExclamation, "Pas d'importation à partir d
'Excel"
xlApp.Quit
Set xlApp = Nothing
Exit sub
Else
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'ensuite tu positionnes le reste de tes opérations ici
'et tu n'oublies pas de positionner à la fin :
End If
3°) If NomClasseurXL = "" Then
Ceci n'a pas d'intérêt puisque tu effectues déjà ton contrôle auparavant
avec If oDialog.Show = 0
4°) Je vois d'autres choses et plus particulièrement je te conseillerai
de travailler sur une gestion d'erreur globale (même si tu évoques un If
Err.Number = 1004 qui ne me paraît pas nécessaire - tu as déjà fait ton
contrôle précédement ! et de toute façon c'est mal positionné)
Sinon, tu répètes dans ton code l'affectation de la propriété Visible à
False pour XLApp, ça me paraît inutile (dans la partie commençant par
With XLApp).
Je ne peux pas tester ta procédure pour la suite, je ne possède pas
MSProject, mais tu devrais avancer un peu quand même avec ces
suggestions.
Cordialement
Pascal
"Woody" <Woody@blackwood.net.invalid> a écrit dans le message de news:
eEbMZPWFIHA.1212@TK2MSFTNGP05.phx.gbl...
Bonjour Pascal,
Voici le code incriminé!
Merci pour ton aide
Sub ImportationExcel_3c()
'Dans Art Gr DT Bis.mpp
Dim XLApp As Excel.Application 'La référence par variable à liaison
précoce offre de meilleures performances, mais ne peut contenir qu'une
référence à la classe indiquée dans la déclaration.
Dim Chemin As String, Clic As Integer
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
'Application.ScreenUpdating = False 'Fige l'affichage écran
'Set XLApp = New Excel.Application 'Exige une Référence sur une version
d'Excel
Set XLApp = CreateObject("Excel.Application") 'Va chercher le Excel qui
figure dans la Base de registre, quelque soit sa version,
'mais ne présente plus d'aide à la synthaxe.
XLApp.Visible = False
'ChDrive "D" '"D:Mes documentsDT a traiter"
'Chemin = "D:Mes documentsDT a traiter" 'Inutile avec la boîte de
dialogue msoFileDialogFilePicker
'ChDir Chemin 'Modifie le répertoire par
défaut
'NB : La boîte de dialogue msoFileDialogFilePicker n'utilise pas le
dossier par défaut,
'mais ce qui est spécifié dans Excel comme répertoire de démarrage
'NomClasseurXL = InputBox("Nom du classeur Excel :", "Importation des
données Excel", "Demande Opération 1.xls")
Dim oDialog As Office.FileDialog 'Create a
FileDialog object
'Create a FileDialog object as a File Picker dialog box:
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker) 'Ouvre
une boîte de dialogue MS Office FilePicker : 'Create a FileDialog object
as a File Picker dialog box.
oDialog.InitialFileName = "D:Mes documentsDT a traiter" 'Set the
initial path to the D: drive.
oDialog.Filters.Add "Fichiers Excel", "*.xls"
'Sélection sur les classeurs .XLS
oDialog.Title = "Sélectionnez le fichier Excel" 'Titre de
la boîte de dialogue
oDialog.AllowMultiSelect = False 'Pas de
sélection multiple
If oDialog.Show = 0 Then 'Affiche la boîte de dialogue MS Office
FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'MsgBox "Le classeur Excel sélectionné est : " &
NomClasseurXL 'Empêche la fermeture de la fenêtre Excel
End If
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à
partir d'Excel"
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub
End If
Set oDialog = Nothing
If NomClasseurXL = "" Then 'Si l'opérateur n'a rien
sélectionné
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub 'on quitte la procédure
End If
XLApp.WorkBooks.Open NomClasseurXL
XLApp.Visible = False
With XLApp
'.Workbooks.Open FileName:=NomClasseurXL 'Ouvre le Classeur
voulu
'MsgBox "Erreur N° : " & Err.Number & " " & Err.Description
'Erreurs récupérables
If Err.Number = 1004 Then 'Fichier n'existe pas
MsgBox "Erreur sur le nom du classeur Excel ou sur le chemin
d'accès"
Exit Sub
End If
'.WindowState = xlMinimized 'Réduit la fenêtre XL
(mais la réaffiche)
.Visible = False 'True 'Fenêtre
invisible/visible
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
Clic = MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import
des données Excel")
If Clic = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
NomTache = .Range("DTimpr!MSPTache").Rows(1).Value 'Lit le
champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=NomTache, TaskID:=1 'Dépose
le nom de la tâche qui figure dans le champ "DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
'EnterpriseTaskOutlineCode1
End With
'Application.ScreenUpdating = True
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
XLApp.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur
sans sauvegarde !
XLApp.Quit
Set XLApp = Nothing
End Sub
Pascal,
Merci pour tout ce travail de correction !
Je me suis appliqué à effectuer toutes les corrections suggérées (sauf la
gestion d'erreur globale que je n'ai pas encore faite). La procédure
fonctionne mais avec les deux inconvénients qui incriminent l'efficacité
du XLApp.Visible = False
- Si je clique OK dans la boite de dialog msoFileDialogFilePicker, la
fenêtre Excel apparaît une seconde puis disparaît. Le reste se passe bien.
- Si je clique Annuler, la fenêtre Excel (vide) reste figée à l'écran. Je
dois la fermer manuellement pour accéder au
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à partir
d'Excel". Ensuite tout se passe normalement.
Quelque idée ?
Merci encore,
Woody
"papou" a écrit dans le
message de news:Woody
Vite fait comme ça quelques problèmes :
1°) Dim xlApp As Excel.Application
Tu dois faire un choix (je crois d'ailleurs que je t'en avais déjà touché
un mot) :
Soit
Tu conserves ta déclaration telle quelle, alors tu dois utiliser la
méthode
Set XLApp = New Excel.Application
Où
Si tu utilises la méthode
Set XLApp = CreateObject("Excel.Application")
Alors tu modifies ta déclaration :
Dim xlApp As Object
2°) Ensuite :
If oDialog.Show = 0 Then
'Affiche la boîte de dialogue MS Office FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
Tu n'as pas bien noté mon explication d'hier :
*** La méthode oDialog.Show renvoie 0 (zéro) si l'opération a été annulée
***
Hors dans ton code tu continues, il faut donc que tu positionnes l'arrêt
de ta procédure à ce niveau :
If oDialog.Show = 0 Then
Msgbox "Opération annulée", vbExclamation, "Pas d'importation à partir d
'Excel"
xlApp.Quit
Set xlApp = Nothing
Exit sub
Else
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'ensuite tu positionnes le reste de tes opérations ici
'et tu n'oublies pas de positionner à la fin :
End If
3°) If NomClasseurXL = "" Then
Ceci n'a pas d'intérêt puisque tu effectues déjà ton contrôle auparavant
avec If oDialog.Show = 0
4°) Je vois d'autres choses et plus particulièrement je te conseillerai
de travailler sur une gestion d'erreur globale (même si tu évoques un If
Err.Number = 1004 qui ne me paraît pas nécessaire - tu as déjà fait ton
contrôle précédement ! et de toute façon c'est mal positionné)
Sinon, tu répètes dans ton code l'affectation de la propriété Visible à
False pour XLApp, ça me paraît inutile (dans la partie commençant par
With XLApp).
Je ne peux pas tester ta procédure pour la suite, je ne possède pas
MSProject, mais tu devrais avancer un peu quand même avec ces
suggestions.
Cordialement
Pascal
"Woody" a écrit dans le message de news:Bonjour Pascal,
Voici le code incriminé!
Merci pour ton aide
Sub ImportationExcel_3c()
'Dans Art Gr DT Bis.mpp
Dim XLApp As Excel.Application 'La référence par variable à liaison
précoce offre de meilleures performances, mais ne peut contenir qu'une
référence à la classe indiquée dans la déclaration.
Dim Chemin As String, Clic As Integer
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
'Application.ScreenUpdating = False 'Fige l'affichage écran
'Set XLApp = New Excel.Application 'Exige une Référence sur une version
d'Excel
Set XLApp = CreateObject("Excel.Application") 'Va chercher le Excel qui
figure dans la Base de registre, quelque soit sa version,
'mais ne présente plus d'aide à la synthaxe.
XLApp.Visible = False
'ChDrive "D" '"D:Mes documentsDT a traiter"
'Chemin = "D:Mes documentsDT a traiter" 'Inutile avec la boîte de
dialogue msoFileDialogFilePicker
'ChDir Chemin 'Modifie le répertoire par
défaut
'NB : La boîte de dialogue msoFileDialogFilePicker n'utilise pas le
dossier par défaut,
'mais ce qui est spécifié dans Excel comme répertoire de démarrage
'NomClasseurXL = InputBox("Nom du classeur Excel :", "Importation des
données Excel", "Demande Opération 1.xls")
Dim oDialog As Office.FileDialog 'Create a
FileDialog object
'Create a FileDialog object as a File Picker dialog box:
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker) 'Ouvre
une boîte de dialogue MS Office FilePicker : 'Create a FileDialog object
as a File Picker dialog box.
oDialog.InitialFileName = "D:Mes documentsDT a traiter" 'Set the
initial path to the D: drive.
oDialog.Filters.Add "Fichiers Excel", "*.xls"
'Sélection sur les classeurs .XLS
oDialog.Title = "Sélectionnez le fichier Excel" 'Titre de
la boîte de dialogue
oDialog.AllowMultiSelect = False 'Pas de
sélection multiple
If oDialog.Show = 0 Then 'Affiche la boîte de dialogue MS Office
FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'MsgBox "Le classeur Excel sélectionné est : " &
NomClasseurXL 'Empêche la fermeture de la fenêtre Excel
End If
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à
partir d'Excel"
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub
End If
Set oDialog = Nothing
If NomClasseurXL = "" Then 'Si l'opérateur n'a rien
sélectionné
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub 'on quitte la procédure
End If
XLApp.WorkBooks.Open NomClasseurXL
XLApp.Visible = False
With XLApp
'.Workbooks.Open FileName:=NomClasseurXL 'Ouvre le Classeur
voulu
'MsgBox "Erreur N° : " & Err.Number & " " & Err.Description
'Erreurs récupérables
If Err.Number = 1004 Then 'Fichier n'existe pas
MsgBox "Erreur sur le nom du classeur Excel ou sur le chemin
d'accès"
Exit Sub
End If
'.WindowState = xlMinimized 'Réduit la fenêtre XL
(mais la réaffiche)
.Visible = False 'True 'Fenêtre
invisible/visible
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
Clic = MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import
des données Excel")
If Clic = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
NomTache = .Range("DTimpr!MSPTache").Rows(1).Value 'Lit le
champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=NomTache, TaskID:=1 'Dépose
le nom de la tâche qui figure dans le champ "DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
'EnterpriseTaskOutlineCode1
End With
'Application.ScreenUpdating = True
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
XLApp.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur
sans sauvegarde !
XLApp.Quit
Set XLApp = Nothing
End Sub
Pascal,
Merci pour tout ce travail de correction !
Je me suis appliqué à effectuer toutes les corrections suggérées (sauf la
gestion d'erreur globale que je n'ai pas encore faite). La procédure
fonctionne mais avec les deux inconvénients qui incriminent l'efficacité
du XLApp.Visible = False
- Si je clique OK dans la boite de dialog msoFileDialogFilePicker, la
fenêtre Excel apparaît une seconde puis disparaît. Le reste se passe bien.
- Si je clique Annuler, la fenêtre Excel (vide) reste figée à l'écran. Je
dois la fermer manuellement pour accéder au
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à partir
d'Excel". Ensuite tout se passe normalement.
Quelque idée ?
Merci encore,
Woody
"papou" a écrit dans le
message de news:Woody
Vite fait comme ça quelques problèmes :
1°) Dim xlApp As Excel.Application
Tu dois faire un choix (je crois d'ailleurs que je t'en avais déjà touché
un mot) :
Soit
Tu conserves ta déclaration telle quelle, alors tu dois utiliser la
méthode
Set XLApp = New Excel.Application
Où
Si tu utilises la méthode
Set XLApp = CreateObject("Excel.Application")
Alors tu modifies ta déclaration :
Dim xlApp As Object
2°) Ensuite :
If oDialog.Show = 0 Then
'Affiche la boîte de dialogue MS Office FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
Tu n'as pas bien noté mon explication d'hier :
*** La méthode oDialog.Show renvoie 0 (zéro) si l'opération a été annulée
***
Hors dans ton code tu continues, il faut donc que tu positionnes l'arrêt
de ta procédure à ce niveau :
If oDialog.Show = 0 Then
Msgbox "Opération annulée", vbExclamation, "Pas d'importation à partir d
'Excel"
xlApp.Quit
Set xlApp = Nothing
Exit sub
Else
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'ensuite tu positionnes le reste de tes opérations ici
'et tu n'oublies pas de positionner à la fin :
End If
3°) If NomClasseurXL = "" Then
Ceci n'a pas d'intérêt puisque tu effectues déjà ton contrôle auparavant
avec If oDialog.Show = 0
4°) Je vois d'autres choses et plus particulièrement je te conseillerai
de travailler sur une gestion d'erreur globale (même si tu évoques un If
Err.Number = 1004 qui ne me paraît pas nécessaire - tu as déjà fait ton
contrôle précédement ! et de toute façon c'est mal positionné)
Sinon, tu répètes dans ton code l'affectation de la propriété Visible à
False pour XLApp, ça me paraît inutile (dans la partie commençant par
With XLApp).
Je ne peux pas tester ta procédure pour la suite, je ne possède pas
MSProject, mais tu devrais avancer un peu quand même avec ces
suggestions.
Cordialement
Pascal
"Woody" a écrit dans le message de news:Bonjour Pascal,
Voici le code incriminé!
Merci pour ton aide
Sub ImportationExcel_3c()
'Dans Art Gr DT Bis.mpp
Dim XLApp As Excel.Application 'La référence par variable à liaison
précoce offre de meilleures performances, mais ne peut contenir qu'une
référence à la classe indiquée dans la déclaration.
Dim Chemin As String, Clic As Integer
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
'Application.ScreenUpdating = False 'Fige l'affichage écran
'Set XLApp = New Excel.Application 'Exige une Référence sur une version
d'Excel
Set XLApp = CreateObject("Excel.Application") 'Va chercher le Excel qui
figure dans la Base de registre, quelque soit sa version,
'mais ne présente plus d'aide à la synthaxe.
XLApp.Visible = False
'ChDrive "D" '"D:Mes documentsDT a traiter"
'Chemin = "D:Mes documentsDT a traiter" 'Inutile avec la boîte de
dialogue msoFileDialogFilePicker
'ChDir Chemin 'Modifie le répertoire par
défaut
'NB : La boîte de dialogue msoFileDialogFilePicker n'utilise pas le
dossier par défaut,
'mais ce qui est spécifié dans Excel comme répertoire de démarrage
'NomClasseurXL = InputBox("Nom du classeur Excel :", "Importation des
données Excel", "Demande Opération 1.xls")
Dim oDialog As Office.FileDialog 'Create a
FileDialog object
'Create a FileDialog object as a File Picker dialog box:
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker) 'Ouvre
une boîte de dialogue MS Office FilePicker : 'Create a FileDialog object
as a File Picker dialog box.
oDialog.InitialFileName = "D:Mes documentsDT a traiter" 'Set the
initial path to the D: drive.
oDialog.Filters.Add "Fichiers Excel", "*.xls"
'Sélection sur les classeurs .XLS
oDialog.Title = "Sélectionnez le fichier Excel" 'Titre de
la boîte de dialogue
oDialog.AllowMultiSelect = False 'Pas de
sélection multiple
If oDialog.Show = 0 Then 'Affiche la boîte de dialogue MS Office
FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'MsgBox "Le classeur Excel sélectionné est : " &
NomClasseurXL 'Empêche la fermeture de la fenêtre Excel
End If
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à
partir d'Excel"
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub
End If
Set oDialog = Nothing
If NomClasseurXL = "" Then 'Si l'opérateur n'a rien
sélectionné
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub 'on quitte la procédure
End If
XLApp.WorkBooks.Open NomClasseurXL
XLApp.Visible = False
With XLApp
'.Workbooks.Open FileName:=NomClasseurXL 'Ouvre le Classeur
voulu
'MsgBox "Erreur N° : " & Err.Number & " " & Err.Description
'Erreurs récupérables
If Err.Number = 1004 Then 'Fichier n'existe pas
MsgBox "Erreur sur le nom du classeur Excel ou sur le chemin
d'accès"
Exit Sub
End If
'.WindowState = xlMinimized 'Réduit la fenêtre XL
(mais la réaffiche)
.Visible = False 'True 'Fenêtre
invisible/visible
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
Clic = MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import
des données Excel")
If Clic = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
NomTache = .Range("DTimpr!MSPTache").Rows(1).Value 'Lit le
champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=NomTache, TaskID:=1 'Dépose
le nom de la tâche qui figure dans le champ "DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
'EnterpriseTaskOutlineCode1
End With
'Application.ScreenUpdating = True
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
XLApp.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur
sans sauvegarde !
XLApp.Quit
Set XLApp = Nothing
End Sub
Pascal,
Merci pour tout ce travail de correction !
Je me suis appliqué à effectuer toutes les corrections suggérées (sauf la
gestion d'erreur globale que je n'ai pas encore faite). La procédure
fonctionne mais avec les deux inconvénients qui incriminent l'efficacité
du XLApp.Visible = False
- Si je clique OK dans la boite de dialog msoFileDialogFilePicker, la
fenêtre Excel apparaît une seconde puis disparaît. Le reste se passe bien.
- Si je clique Annuler, la fenêtre Excel (vide) reste figée à l'écran. Je
dois la fermer manuellement pour accéder au
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à partir
d'Excel". Ensuite tout se passe normalement.
Quelque idée ?
Merci encore,
Woody
"papou" <cpapounospamthanx@laposte.netnospamthanks> a écrit dans le
message de news: OnpkesWFIHA.5228@TK2MSFTNGP05.phx.gbl...
Woody
Vite fait comme ça quelques problèmes :
1°) Dim xlApp As Excel.Application
Tu dois faire un choix (je crois d'ailleurs que je t'en avais déjà touché
un mot) :
Soit
Tu conserves ta déclaration telle quelle, alors tu dois utiliser la
méthode
Set XLApp = New Excel.Application
Où
Si tu utilises la méthode
Set XLApp = CreateObject("Excel.Application")
Alors tu modifies ta déclaration :
Dim xlApp As Object
2°) Ensuite :
If oDialog.Show = 0 Then
'Affiche la boîte de dialogue MS Office FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
Tu n'as pas bien noté mon explication d'hier :
*** La méthode oDialog.Show renvoie 0 (zéro) si l'opération a été annulée
***
Hors dans ton code tu continues, il faut donc que tu positionnes l'arrêt
de ta procédure à ce niveau :
If oDialog.Show = 0 Then
Msgbox "Opération annulée", vbExclamation, "Pas d'importation à partir d
'Excel"
xlApp.Quit
Set xlApp = Nothing
Exit sub
Else
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'ensuite tu positionnes le reste de tes opérations ici
'et tu n'oublies pas de positionner à la fin :
End If
3°) If NomClasseurXL = "" Then
Ceci n'a pas d'intérêt puisque tu effectues déjà ton contrôle auparavant
avec If oDialog.Show = 0
4°) Je vois d'autres choses et plus particulièrement je te conseillerai
de travailler sur une gestion d'erreur globale (même si tu évoques un If
Err.Number = 1004 qui ne me paraît pas nécessaire - tu as déjà fait ton
contrôle précédement ! et de toute façon c'est mal positionné)
Sinon, tu répètes dans ton code l'affectation de la propriété Visible à
False pour XLApp, ça me paraît inutile (dans la partie commençant par
With XLApp).
Je ne peux pas tester ta procédure pour la suite, je ne possède pas
MSProject, mais tu devrais avancer un peu quand même avec ces
suggestions.
Cordialement
Pascal
"Woody" <Woody@blackwood.net.invalid> a écrit dans le message de news:
eEbMZPWFIHA.1212@TK2MSFTNGP05.phx.gbl...
Bonjour Pascal,
Voici le code incriminé!
Merci pour ton aide
Sub ImportationExcel_3c()
'Dans Art Gr DT Bis.mpp
Dim XLApp As Excel.Application 'La référence par variable à liaison
précoce offre de meilleures performances, mais ne peut contenir qu'une
référence à la classe indiquée dans la déclaration.
Dim Chemin As String, Clic As Integer
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
'Application.ScreenUpdating = False 'Fige l'affichage écran
'Set XLApp = New Excel.Application 'Exige une Référence sur une version
d'Excel
Set XLApp = CreateObject("Excel.Application") 'Va chercher le Excel qui
figure dans la Base de registre, quelque soit sa version,
'mais ne présente plus d'aide à la synthaxe.
XLApp.Visible = False
'ChDrive "D" '"D:Mes documentsDT a traiter"
'Chemin = "D:Mes documentsDT a traiter" 'Inutile avec la boîte de
dialogue msoFileDialogFilePicker
'ChDir Chemin 'Modifie le répertoire par
défaut
'NB : La boîte de dialogue msoFileDialogFilePicker n'utilise pas le
dossier par défaut,
'mais ce qui est spécifié dans Excel comme répertoire de démarrage
'NomClasseurXL = InputBox("Nom du classeur Excel :", "Importation des
données Excel", "Demande Opération 1.xls")
Dim oDialog As Office.FileDialog 'Create a
FileDialog object
'Create a FileDialog object as a File Picker dialog box:
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker) 'Ouvre
une boîte de dialogue MS Office FilePicker : 'Create a FileDialog object
as a File Picker dialog box.
oDialog.InitialFileName = "D:Mes documentsDT a traiter" 'Set the
initial path to the D: drive.
oDialog.Filters.Add "Fichiers Excel", "*.xls"
'Sélection sur les classeurs .XLS
oDialog.Title = "Sélectionnez le fichier Excel" 'Titre de
la boîte de dialogue
oDialog.AllowMultiSelect = False 'Pas de
sélection multiple
If oDialog.Show = 0 Then 'Affiche la boîte de dialogue MS Office
FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'MsgBox "Le classeur Excel sélectionné est : " &
NomClasseurXL 'Empêche la fermeture de la fenêtre Excel
End If
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à
partir d'Excel"
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub
End If
Set oDialog = Nothing
If NomClasseurXL = "" Then 'Si l'opérateur n'a rien
sélectionné
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub 'on quitte la procédure
End If
XLApp.WorkBooks.Open NomClasseurXL
XLApp.Visible = False
With XLApp
'.Workbooks.Open FileName:=NomClasseurXL 'Ouvre le Classeur
voulu
'MsgBox "Erreur N° : " & Err.Number & " " & Err.Description
'Erreurs récupérables
If Err.Number = 1004 Then 'Fichier n'existe pas
MsgBox "Erreur sur le nom du classeur Excel ou sur le chemin
d'accès"
Exit Sub
End If
'.WindowState = xlMinimized 'Réduit la fenêtre XL
(mais la réaffiche)
.Visible = False 'True 'Fenêtre
invisible/visible
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
Clic = MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import
des données Excel")
If Clic = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
NomTache = .Range("DTimpr!MSPTache").Rows(1).Value 'Lit le
champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=NomTache, TaskID:=1 'Dépose
le nom de la tâche qui figure dans le champ "DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
'EnterpriseTaskOutlineCode1
End With
'Application.ScreenUpdating = True
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
XLApp.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur
sans sauvegarde !
XLApp.Quit
Set XLApp = Nothing
End Sub
Pascal,
Merci pour tout ce travail de correction !
Je me suis appliqué à effectuer toutes les corrections suggérées (sauf la
gestion d'erreur globale que je n'ai pas encore faite). La procédure
fonctionne mais avec les deux inconvénients qui incriminent l'efficacité
du XLApp.Visible = False
- Si je clique OK dans la boite de dialog msoFileDialogFilePicker, la
fenêtre Excel apparaît une seconde puis disparaît. Le reste se passe bien.
- Si je clique Annuler, la fenêtre Excel (vide) reste figée à l'écran. Je
dois la fermer manuellement pour accéder au
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à partir
d'Excel". Ensuite tout se passe normalement.
Quelque idée ?
Merci encore,
Woody
"papou" a écrit dans le
message de news:Woody
Vite fait comme ça quelques problèmes :
1°) Dim xlApp As Excel.Application
Tu dois faire un choix (je crois d'ailleurs que je t'en avais déjà touché
un mot) :
Soit
Tu conserves ta déclaration telle quelle, alors tu dois utiliser la
méthode
Set XLApp = New Excel.Application
Où
Si tu utilises la méthode
Set XLApp = CreateObject("Excel.Application")
Alors tu modifies ta déclaration :
Dim xlApp As Object
2°) Ensuite :
If oDialog.Show = 0 Then
'Affiche la boîte de dialogue MS Office FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
Tu n'as pas bien noté mon explication d'hier :
*** La méthode oDialog.Show renvoie 0 (zéro) si l'opération a été annulée
***
Hors dans ton code tu continues, il faut donc que tu positionnes l'arrêt
de ta procédure à ce niveau :
If oDialog.Show = 0 Then
Msgbox "Opération annulée", vbExclamation, "Pas d'importation à partir d
'Excel"
xlApp.Quit
Set xlApp = Nothing
Exit sub
Else
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'ensuite tu positionnes le reste de tes opérations ici
'et tu n'oublies pas de positionner à la fin :
End If
3°) If NomClasseurXL = "" Then
Ceci n'a pas d'intérêt puisque tu effectues déjà ton contrôle auparavant
avec If oDialog.Show = 0
4°) Je vois d'autres choses et plus particulièrement je te conseillerai
de travailler sur une gestion d'erreur globale (même si tu évoques un If
Err.Number = 1004 qui ne me paraît pas nécessaire - tu as déjà fait ton
contrôle précédement ! et de toute façon c'est mal positionné)
Sinon, tu répètes dans ton code l'affectation de la propriété Visible à
False pour XLApp, ça me paraît inutile (dans la partie commençant par
With XLApp).
Je ne peux pas tester ta procédure pour la suite, je ne possède pas
MSProject, mais tu devrais avancer un peu quand même avec ces
suggestions.
Cordialement
Pascal
"Woody" a écrit dans le message de news:Bonjour Pascal,
Voici le code incriminé!
Merci pour ton aide
Sub ImportationExcel_3c()
'Dans Art Gr DT Bis.mpp
Dim XLApp As Excel.Application 'La référence par variable à liaison
précoce offre de meilleures performances, mais ne peut contenir qu'une
référence à la classe indiquée dans la déclaration.
Dim Chemin As String, Clic As Integer
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
'Application.ScreenUpdating = False 'Fige l'affichage écran
'Set XLApp = New Excel.Application 'Exige une Référence sur une version
d'Excel
Set XLApp = CreateObject("Excel.Application") 'Va chercher le Excel qui
figure dans la Base de registre, quelque soit sa version,
'mais ne présente plus d'aide à la synthaxe.
XLApp.Visible = False
'ChDrive "D" '"D:Mes documentsDT a traiter"
'Chemin = "D:Mes documentsDT a traiter" 'Inutile avec la boîte de
dialogue msoFileDialogFilePicker
'ChDir Chemin 'Modifie le répertoire par
défaut
'NB : La boîte de dialogue msoFileDialogFilePicker n'utilise pas le
dossier par défaut,
'mais ce qui est spécifié dans Excel comme répertoire de démarrage
'NomClasseurXL = InputBox("Nom du classeur Excel :", "Importation des
données Excel", "Demande Opération 1.xls")
Dim oDialog As Office.FileDialog 'Create a
FileDialog object
'Create a FileDialog object as a File Picker dialog box:
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker) 'Ouvre
une boîte de dialogue MS Office FilePicker : 'Create a FileDialog object
as a File Picker dialog box.
oDialog.InitialFileName = "D:Mes documentsDT a traiter" 'Set the
initial path to the D: drive.
oDialog.Filters.Add "Fichiers Excel", "*.xls"
'Sélection sur les classeurs .XLS
oDialog.Title = "Sélectionnez le fichier Excel" 'Titre de
la boîte de dialogue
oDialog.AllowMultiSelect = False 'Pas de
sélection multiple
If oDialog.Show = 0 Then 'Affiche la boîte de dialogue MS Office
FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'MsgBox "Le classeur Excel sélectionné est : " &
NomClasseurXL 'Empêche la fermeture de la fenêtre Excel
End If
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à
partir d'Excel"
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub
End If
Set oDialog = Nothing
If NomClasseurXL = "" Then 'Si l'opérateur n'a rien
sélectionné
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub 'on quitte la procédure
End If
XLApp.WorkBooks.Open NomClasseurXL
XLApp.Visible = False
With XLApp
'.Workbooks.Open FileName:=NomClasseurXL 'Ouvre le Classeur
voulu
'MsgBox "Erreur N° : " & Err.Number & " " & Err.Description
'Erreurs récupérables
If Err.Number = 1004 Then 'Fichier n'existe pas
MsgBox "Erreur sur le nom du classeur Excel ou sur le chemin
d'accès"
Exit Sub
End If
'.WindowState = xlMinimized 'Réduit la fenêtre XL
(mais la réaffiche)
.Visible = False 'True 'Fenêtre
invisible/visible
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
Clic = MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import
des données Excel")
If Clic = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
NomTache = .Range("DTimpr!MSPTache").Rows(1).Value 'Lit le
champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=NomTache, TaskID:=1 'Dépose
le nom de la tâche qui figure dans le champ "DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
'EnterpriseTaskOutlineCode1
End With
'Application.ScreenUpdating = True
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
XLApp.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur
sans sauvegarde !
XLApp.Quit
Set XLApp = Nothing
End Sub
Rebonjour Woody
Chose promise chose due ;-)
Je viens d'installer MSProject.
Par contre comme je n'y connais pas grand chose pour l'instant, j'ai
quelques questions :
1 - Le code fonctionne t-il sur un projet vierge ?
2 - Quels sont les type de données attendus depuis la feuille Excel ?
(Les celllules avec les noms définis MSPTache, MSPNBoeuvre et
MSPdemandeur)
Sinon, une interrogation sur l'utilisation de
Range("DTimpr!MSPTache").Rows(1).Value
Avec un test complet, nous pourrons parvenir à ce que tu souhaites
j'espère.
Cordialement
Pascal
"Woody" a écrit dans le message de news:Pascal,
Merci pour tout ce travail de correction !
Je me suis appliqué à effectuer toutes les corrections suggérées (sauf la
gestion d'erreur globale que je n'ai pas encore faite). La procédure
fonctionne mais avec les deux inconvénients qui incriminent l'efficacité
du XLApp.Visible = False
- Si je clique OK dans la boite de dialog msoFileDialogFilePicker, la
fenêtre Excel apparaît une seconde puis disparaît. Le reste se passe
bien.
- Si je clique Annuler, la fenêtre Excel (vide) reste figée à l'écran. Je
dois la fermer manuellement pour accéder au
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à partir
d'Excel". Ensuite tout se passe normalement.
Quelque idée ?
Merci encore,
Woody
"papou" a écrit dans le
message de news:Woody
Vite fait comme ça quelques problèmes :
1°) Dim xlApp As Excel.Application
Tu dois faire un choix (je crois d'ailleurs que je t'en avais déjà
touché un mot) :
Soit
Tu conserves ta déclaration telle quelle, alors tu dois utiliser la
méthode
Set XLApp = New Excel.Application
Où
Si tu utilises la méthode
Set XLApp = CreateObject("Excel.Application")
Alors tu modifies ta déclaration :
Dim xlApp As Object
2°) Ensuite :
If oDialog.Show = 0 Then
'Affiche la boîte de dialogue MS Office FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
Tu n'as pas bien noté mon explication d'hier :
*** La méthode oDialog.Show renvoie 0 (zéro) si l'opération a été
annulée ***
Hors dans ton code tu continues, il faut donc que tu positionnes l'arrêt
de ta procédure à ce niveau :
If oDialog.Show = 0 Then
Msgbox "Opération annulée", vbExclamation, "Pas d'importation à partir d
'Excel"
xlApp.Quit
Set xlApp = Nothing
Exit sub
Else
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'ensuite tu positionnes le reste de tes opérations ici
'et tu n'oublies pas de positionner à la fin :
End If
3°) If NomClasseurXL = "" Then
Ceci n'a pas d'intérêt puisque tu effectues déjà ton contrôle auparavant
avec If oDialog.Show = 0
4°) Je vois d'autres choses et plus particulièrement je te conseillerai
de travailler sur une gestion d'erreur globale (même si tu évoques un If
Err.Number = 1004 qui ne me paraît pas nécessaire - tu as déjà fait ton
contrôle précédement ! et de toute façon c'est mal positionné)
Sinon, tu répètes dans ton code l'affectation de la propriété Visible à
False pour XLApp, ça me paraît inutile (dans la partie commençant par
With XLApp).
Je ne peux pas tester ta procédure pour la suite, je ne possède pas
MSProject, mais tu devrais avancer un peu quand même avec ces
suggestions.
Cordialement
Pascal
"Woody" a écrit dans le message de news:Bonjour Pascal,
Voici le code incriminé!
Merci pour ton aide
Sub ImportationExcel_3c()
'Dans Art Gr DT Bis.mpp
Dim XLApp As Excel.Application 'La référence par variable à liaison
précoce offre de meilleures performances, mais ne peut contenir qu'une
référence à la classe indiquée dans la déclaration.
Dim Chemin As String, Clic As Integer
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
'Application.ScreenUpdating = False 'Fige l'affichage écran
'Set XLApp = New Excel.Application 'Exige une Référence sur une
version d'Excel
Set XLApp = CreateObject("Excel.Application") 'Va chercher le Excel
qui figure dans la Base de registre, quelque soit sa version,
'mais ne présente plus d'aide à la synthaxe.
XLApp.Visible = False
'ChDrive "D" '"D:Mes documentsDT a traiter"
'Chemin = "D:Mes documentsDT a traiter" 'Inutile avec la boîte de
dialogue msoFileDialogFilePicker
'ChDir Chemin 'Modifie le répertoire par
défaut
'NB : La boîte de dialogue msoFileDialogFilePicker n'utilise pas le
dossier par défaut,
'mais ce qui est spécifié dans Excel comme répertoire de démarrage
'NomClasseurXL = InputBox("Nom du classeur Excel :", "Importation des
données Excel", "Demande Opération 1.xls")
Dim oDialog As Office.FileDialog 'Create
a FileDialog object
'Create a FileDialog object as a File Picker dialog box:
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker) 'Ouvre
une boîte de dialogue MS Office FilePicker : 'Create a FileDialog
object as a File Picker dialog box.
oDialog.InitialFileName = "D:Mes documentsDT a traiter" 'Set the
initial path to the D: drive.
oDialog.Filters.Add "Fichiers Excel", "*.xls" 'Sélection sur les
classeurs .XLS
oDialog.Title = "Sélectionnez le fichier Excel" 'Titre
de la boîte de dialogue
oDialog.AllowMultiSelect = False 'Pas de
sélection multiple
If oDialog.Show = 0 Then 'Affiche la boîte de dialogue MS Office
FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'MsgBox "Le classeur Excel sélectionné est : " &
NomClasseurXL 'Empêche la fermeture de la fenêtre Excel
End If
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à
partir d'Excel"
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet
XL
Exit Sub
End If
Set oDialog = Nothing
If NomClasseurXL = "" Then 'Si l'opérateur n'a rien
sélectionné
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub 'on quitte la procédure
End If
XLApp.WorkBooks.Open NomClasseurXL
XLApp.Visible = False
With XLApp
'.Workbooks.Open FileName:=NomClasseurXL 'Ouvre le Classeur
voulu
'MsgBox "Erreur N° : " & Err.Number & " " & Err.Description 'Erreurs
récupérables
If Err.Number = 1004 Then 'Fichier n'existe
pas
MsgBox "Erreur sur le nom du classeur Excel ou sur le chemin
d'accès"
Exit Sub
End If
'.WindowState = xlMinimized 'Réduit la fenêtre XL
(mais la réaffiche)
.Visible = False 'True 'Fenêtre
invisible/visible
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
Clic = MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import
des données Excel")
If Clic = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
NomTache = .Range("DTimpr!MSPTache").Rows(1).Value 'Lit le
champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=NomTache, TaskID:=1 'Dépose
le nom de la tâche qui figure dans le champ "DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
'EnterpriseTaskOutlineCode1
End With
'Application.ScreenUpdating = True
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
XLApp.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur
sans sauvegarde !
XLApp.Quit
Set XLApp = Nothing
End Sub
Rebonjour Woody
Chose promise chose due ;-)
Je viens d'installer MSProject.
Par contre comme je n'y connais pas grand chose pour l'instant, j'ai
quelques questions :
1 - Le code fonctionne t-il sur un projet vierge ?
2 - Quels sont les type de données attendus depuis la feuille Excel ?
(Les celllules avec les noms définis MSPTache, MSPNBoeuvre et
MSPdemandeur)
Sinon, une interrogation sur l'utilisation de
Range("DTimpr!MSPTache").Rows(1).Value
Avec un test complet, nous pourrons parvenir à ce que tu souhaites
j'espère.
Cordialement
Pascal
"Woody" <Woody@blackwood.net.invalid> a écrit dans le message de news:
OVPiQUXFIHA.2004@TK2MSFTNGP06.phx.gbl...
Pascal,
Merci pour tout ce travail de correction !
Je me suis appliqué à effectuer toutes les corrections suggérées (sauf la
gestion d'erreur globale que je n'ai pas encore faite). La procédure
fonctionne mais avec les deux inconvénients qui incriminent l'efficacité
du XLApp.Visible = False
- Si je clique OK dans la boite de dialog msoFileDialogFilePicker, la
fenêtre Excel apparaît une seconde puis disparaît. Le reste se passe
bien.
- Si je clique Annuler, la fenêtre Excel (vide) reste figée à l'écran. Je
dois la fermer manuellement pour accéder au
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à partir
d'Excel". Ensuite tout se passe normalement.
Quelque idée ?
Merci encore,
Woody
"papou" <cpapounospamthanx@laposte.netnospamthanks> a écrit dans le
message de news: OnpkesWFIHA.5228@TK2MSFTNGP05.phx.gbl...
Woody
Vite fait comme ça quelques problèmes :
1°) Dim xlApp As Excel.Application
Tu dois faire un choix (je crois d'ailleurs que je t'en avais déjà
touché un mot) :
Soit
Tu conserves ta déclaration telle quelle, alors tu dois utiliser la
méthode
Set XLApp = New Excel.Application
Où
Si tu utilises la méthode
Set XLApp = CreateObject("Excel.Application")
Alors tu modifies ta déclaration :
Dim xlApp As Object
2°) Ensuite :
If oDialog.Show = 0 Then
'Affiche la boîte de dialogue MS Office FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
Tu n'as pas bien noté mon explication d'hier :
*** La méthode oDialog.Show renvoie 0 (zéro) si l'opération a été
annulée ***
Hors dans ton code tu continues, il faut donc que tu positionnes l'arrêt
de ta procédure à ce niveau :
If oDialog.Show = 0 Then
Msgbox "Opération annulée", vbExclamation, "Pas d'importation à partir d
'Excel"
xlApp.Quit
Set xlApp = Nothing
Exit sub
Else
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'ensuite tu positionnes le reste de tes opérations ici
'et tu n'oublies pas de positionner à la fin :
End If
3°) If NomClasseurXL = "" Then
Ceci n'a pas d'intérêt puisque tu effectues déjà ton contrôle auparavant
avec If oDialog.Show = 0
4°) Je vois d'autres choses et plus particulièrement je te conseillerai
de travailler sur une gestion d'erreur globale (même si tu évoques un If
Err.Number = 1004 qui ne me paraît pas nécessaire - tu as déjà fait ton
contrôle précédement ! et de toute façon c'est mal positionné)
Sinon, tu répètes dans ton code l'affectation de la propriété Visible à
False pour XLApp, ça me paraît inutile (dans la partie commençant par
With XLApp).
Je ne peux pas tester ta procédure pour la suite, je ne possède pas
MSProject, mais tu devrais avancer un peu quand même avec ces
suggestions.
Cordialement
Pascal
"Woody" <Woody@blackwood.net.invalid> a écrit dans le message de news:
eEbMZPWFIHA.1212@TK2MSFTNGP05.phx.gbl...
Bonjour Pascal,
Voici le code incriminé!
Merci pour ton aide
Sub ImportationExcel_3c()
'Dans Art Gr DT Bis.mpp
Dim XLApp As Excel.Application 'La référence par variable à liaison
précoce offre de meilleures performances, mais ne peut contenir qu'une
référence à la classe indiquée dans la déclaration.
Dim Chemin As String, Clic As Integer
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
'Application.ScreenUpdating = False 'Fige l'affichage écran
'Set XLApp = New Excel.Application 'Exige une Référence sur une
version d'Excel
Set XLApp = CreateObject("Excel.Application") 'Va chercher le Excel
qui figure dans la Base de registre, quelque soit sa version,
'mais ne présente plus d'aide à la synthaxe.
XLApp.Visible = False
'ChDrive "D" '"D:Mes documentsDT a traiter"
'Chemin = "D:Mes documentsDT a traiter" 'Inutile avec la boîte de
dialogue msoFileDialogFilePicker
'ChDir Chemin 'Modifie le répertoire par
défaut
'NB : La boîte de dialogue msoFileDialogFilePicker n'utilise pas le
dossier par défaut,
'mais ce qui est spécifié dans Excel comme répertoire de démarrage
'NomClasseurXL = InputBox("Nom du classeur Excel :", "Importation des
données Excel", "Demande Opération 1.xls")
Dim oDialog As Office.FileDialog 'Create
a FileDialog object
'Create a FileDialog object as a File Picker dialog box:
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker) 'Ouvre
une boîte de dialogue MS Office FilePicker : 'Create a FileDialog
object as a File Picker dialog box.
oDialog.InitialFileName = "D:Mes documentsDT a traiter" 'Set the
initial path to the D: drive.
oDialog.Filters.Add "Fichiers Excel", "*.xls" 'Sélection sur les
classeurs .XLS
oDialog.Title = "Sélectionnez le fichier Excel" 'Titre
de la boîte de dialogue
oDialog.AllowMultiSelect = False 'Pas de
sélection multiple
If oDialog.Show = 0 Then 'Affiche la boîte de dialogue MS Office
FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'MsgBox "Le classeur Excel sélectionné est : " &
NomClasseurXL 'Empêche la fermeture de la fenêtre Excel
End If
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à
partir d'Excel"
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet
XL
Exit Sub
End If
Set oDialog = Nothing
If NomClasseurXL = "" Then 'Si l'opérateur n'a rien
sélectionné
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub 'on quitte la procédure
End If
XLApp.WorkBooks.Open NomClasseurXL
XLApp.Visible = False
With XLApp
'.Workbooks.Open FileName:=NomClasseurXL 'Ouvre le Classeur
voulu
'MsgBox "Erreur N° : " & Err.Number & " " & Err.Description 'Erreurs
récupérables
If Err.Number = 1004 Then 'Fichier n'existe
pas
MsgBox "Erreur sur le nom du classeur Excel ou sur le chemin
d'accès"
Exit Sub
End If
'.WindowState = xlMinimized 'Réduit la fenêtre XL
(mais la réaffiche)
.Visible = False 'True 'Fenêtre
invisible/visible
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
Clic = MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import
des données Excel")
If Clic = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
NomTache = .Range("DTimpr!MSPTache").Rows(1).Value 'Lit le
champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=NomTache, TaskID:=1 'Dépose
le nom de la tâche qui figure dans le champ "DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
'EnterpriseTaskOutlineCode1
End With
'Application.ScreenUpdating = True
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
XLApp.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur
sans sauvegarde !
XLApp.Quit
Set XLApp = Nothing
End Sub
Rebonjour Woody
Chose promise chose due ;-)
Je viens d'installer MSProject.
Par contre comme je n'y connais pas grand chose pour l'instant, j'ai
quelques questions :
1 - Le code fonctionne t-il sur un projet vierge ?
2 - Quels sont les type de données attendus depuis la feuille Excel ?
(Les celllules avec les noms définis MSPTache, MSPNBoeuvre et
MSPdemandeur)
Sinon, une interrogation sur l'utilisation de
Range("DTimpr!MSPTache").Rows(1).Value
Avec un test complet, nous pourrons parvenir à ce que tu souhaites
j'espère.
Cordialement
Pascal
"Woody" a écrit dans le message de news:Pascal,
Merci pour tout ce travail de correction !
Je me suis appliqué à effectuer toutes les corrections suggérées (sauf la
gestion d'erreur globale que je n'ai pas encore faite). La procédure
fonctionne mais avec les deux inconvénients qui incriminent l'efficacité
du XLApp.Visible = False
- Si je clique OK dans la boite de dialog msoFileDialogFilePicker, la
fenêtre Excel apparaît une seconde puis disparaît. Le reste se passe
bien.
- Si je clique Annuler, la fenêtre Excel (vide) reste figée à l'écran. Je
dois la fermer manuellement pour accéder au
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à partir
d'Excel". Ensuite tout se passe normalement.
Quelque idée ?
Merci encore,
Woody
"papou" a écrit dans le
message de news:Woody
Vite fait comme ça quelques problèmes :
1°) Dim xlApp As Excel.Application
Tu dois faire un choix (je crois d'ailleurs que je t'en avais déjà
touché un mot) :
Soit
Tu conserves ta déclaration telle quelle, alors tu dois utiliser la
méthode
Set XLApp = New Excel.Application
Où
Si tu utilises la méthode
Set XLApp = CreateObject("Excel.Application")
Alors tu modifies ta déclaration :
Dim xlApp As Object
2°) Ensuite :
If oDialog.Show = 0 Then
'Affiche la boîte de dialogue MS Office FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
Tu n'as pas bien noté mon explication d'hier :
*** La méthode oDialog.Show renvoie 0 (zéro) si l'opération a été
annulée ***
Hors dans ton code tu continues, il faut donc que tu positionnes l'arrêt
de ta procédure à ce niveau :
If oDialog.Show = 0 Then
Msgbox "Opération annulée", vbExclamation, "Pas d'importation à partir d
'Excel"
xlApp.Quit
Set xlApp = Nothing
Exit sub
Else
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'ensuite tu positionnes le reste de tes opérations ici
'et tu n'oublies pas de positionner à la fin :
End If
3°) If NomClasseurXL = "" Then
Ceci n'a pas d'intérêt puisque tu effectues déjà ton contrôle auparavant
avec If oDialog.Show = 0
4°) Je vois d'autres choses et plus particulièrement je te conseillerai
de travailler sur une gestion d'erreur globale (même si tu évoques un If
Err.Number = 1004 qui ne me paraît pas nécessaire - tu as déjà fait ton
contrôle précédement ! et de toute façon c'est mal positionné)
Sinon, tu répètes dans ton code l'affectation de la propriété Visible à
False pour XLApp, ça me paraît inutile (dans la partie commençant par
With XLApp).
Je ne peux pas tester ta procédure pour la suite, je ne possède pas
MSProject, mais tu devrais avancer un peu quand même avec ces
suggestions.
Cordialement
Pascal
"Woody" a écrit dans le message de news:Bonjour Pascal,
Voici le code incriminé!
Merci pour ton aide
Sub ImportationExcel_3c()
'Dans Art Gr DT Bis.mpp
Dim XLApp As Excel.Application 'La référence par variable à liaison
précoce offre de meilleures performances, mais ne peut contenir qu'une
référence à la classe indiquée dans la déclaration.
Dim Chemin As String, Clic As Integer
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
'Application.ScreenUpdating = False 'Fige l'affichage écran
'Set XLApp = New Excel.Application 'Exige une Référence sur une
version d'Excel
Set XLApp = CreateObject("Excel.Application") 'Va chercher le Excel
qui figure dans la Base de registre, quelque soit sa version,
'mais ne présente plus d'aide à la synthaxe.
XLApp.Visible = False
'ChDrive "D" '"D:Mes documentsDT a traiter"
'Chemin = "D:Mes documentsDT a traiter" 'Inutile avec la boîte de
dialogue msoFileDialogFilePicker
'ChDir Chemin 'Modifie le répertoire par
défaut
'NB : La boîte de dialogue msoFileDialogFilePicker n'utilise pas le
dossier par défaut,
'mais ce qui est spécifié dans Excel comme répertoire de démarrage
'NomClasseurXL = InputBox("Nom du classeur Excel :", "Importation des
données Excel", "Demande Opération 1.xls")
Dim oDialog As Office.FileDialog 'Create
a FileDialog object
'Create a FileDialog object as a File Picker dialog box:
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker) 'Ouvre
une boîte de dialogue MS Office FilePicker : 'Create a FileDialog
object as a File Picker dialog box.
oDialog.InitialFileName = "D:Mes documentsDT a traiter" 'Set the
initial path to the D: drive.
oDialog.Filters.Add "Fichiers Excel", "*.xls" 'Sélection sur les
classeurs .XLS
oDialog.Title = "Sélectionnez le fichier Excel" 'Titre
de la boîte de dialogue
oDialog.AllowMultiSelect = False 'Pas de
sélection multiple
If oDialog.Show = 0 Then 'Affiche la boîte de dialogue MS Office
FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'MsgBox "Le classeur Excel sélectionné est : " &
NomClasseurXL 'Empêche la fermeture de la fenêtre Excel
End If
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à
partir d'Excel"
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet
XL
Exit Sub
End If
Set oDialog = Nothing
If NomClasseurXL = "" Then 'Si l'opérateur n'a rien
sélectionné
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub 'on quitte la procédure
End If
XLApp.WorkBooks.Open NomClasseurXL
XLApp.Visible = False
With XLApp
'.Workbooks.Open FileName:=NomClasseurXL 'Ouvre le Classeur
voulu
'MsgBox "Erreur N° : " & Err.Number & " " & Err.Description 'Erreurs
récupérables
If Err.Number = 1004 Then 'Fichier n'existe
pas
MsgBox "Erreur sur le nom du classeur Excel ou sur le chemin
d'accès"
Exit Sub
End If
'.WindowState = xlMinimized 'Réduit la fenêtre XL
(mais la réaffiche)
.Visible = False 'True 'Fenêtre
invisible/visible
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
Clic = MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import
des données Excel")
If Clic = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
NomTache = .Range("DTimpr!MSPTache").Rows(1).Value 'Lit le
champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=NomTache, TaskID:=1 'Dépose
le nom de la tâche qui figure dans le champ "DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
'EnterpriseTaskOutlineCode1
End With
'Application.ScreenUpdating = True
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
XLApp.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur
sans sauvegarde !
XLApp.Quit
Set XLApp = Nothing
End Sub
Woody
Je viens de faire un test sur un projet "bidon".
Avec le code suivant, et donc malgré les précautions prises dans le code
j'ai effectivement une apparition d'Excel mais elle est vraiment **très
furtive**.
Honnêtement je ne pense pas pouvoir faire beaucoup mieux, il semble qu'il
y ait un échange entre les deux applis que l'on ne peut pas maîtriser
totalement ?
Cordialement
Pascal
Sub ImportationExcel_3c()
Dim XLApp As Object
Dim Chemin As String
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
Set XLApp = CreateObject("Excel.Application")
Dim oDialog As Office.FileDialog
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker)
With oDialog
.InitialFileName = "D:Mes documentsDT a traiter"
.Filters.Add "Fichiers Excel", "*.xls"
.Title = "Sélectionnez le fichier Excel"
.AllowMultiSelect = False
If .Show = 0 Then
MsgBox "Opération annulée", vbExclamation, "Pas
d'importation à partir d 'Excel"
XLApp.Quit
Set XLApp = Nothing
Set oDialog = Nothing
Exit Sub
Else
NomClasseurXL = oDialog.SelectedItems(1)
Set oDialog = Nothing
End If
End With
With XLApp
.Visible = False
.WorkBooks.Open NomClasseurXL
.WindowState = -4140
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
If MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import des
données Excel") = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
'Lit le'champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=.Range("DTimpr!MSPTache").Value,
TaskID:=1 'Dépose le 'nom de la tâche qui figure dans le champ
"DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"),TaskID:=1
'SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1 'EnterpriseTaskOutlineCode1
.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur sans
sauvegarde !
.Quit
End With
Set XLApp = Nothing
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
End Sub
"papou" a écrit dans le
message de news: %Rebonjour Woody
Chose promise chose due ;-)
Je viens d'installer MSProject.
Par contre comme je n'y connais pas grand chose pour l'instant, j'ai
quelques questions :
1 - Le code fonctionne t-il sur un projet vierge ?
2 - Quels sont les type de données attendus depuis la feuille Excel ?
(Les celllules avec les noms définis MSPTache, MSPNBoeuvre et
MSPdemandeur)
Sinon, une interrogation sur l'utilisation de
Range("DTimpr!MSPTache").Rows(1).Value
Avec un test complet, nous pourrons parvenir à ce que tu souhaites
j'espère.
Cordialement
Pascal
"Woody" a écrit dans le message de news:Pascal,
Merci pour tout ce travail de correction !
Je me suis appliqué à effectuer toutes les corrections suggérées (sauf
la gestion d'erreur globale que je n'ai pas encore faite). La procédure
fonctionne mais avec les deux inconvénients qui incriminent l'efficacité
du XLApp.Visible = False
- Si je clique OK dans la boite de dialog msoFileDialogFilePicker, la
fenêtre Excel apparaît une seconde puis disparaît. Le reste se passe
bien.
- Si je clique Annuler, la fenêtre Excel (vide) reste figée à l'écran.
Je dois la fermer manuellement pour accéder au
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à partir
d'Excel". Ensuite tout se passe normalement.
Quelque idée ?
Merci encore,
Woody
"papou" a écrit dans le
message de news:Woody
Vite fait comme ça quelques problèmes :
1°) Dim xlApp As Excel.Application
Tu dois faire un choix (je crois d'ailleurs que je t'en avais déjà
touché un mot) :
Soit
Tu conserves ta déclaration telle quelle, alors tu dois utiliser la
méthode
Set XLApp = New Excel.Application
Où
Si tu utilises la méthode
Set XLApp = CreateObject("Excel.Application")
Alors tu modifies ta déclaration :
Dim xlApp As Object
2°) Ensuite :
If oDialog.Show = 0 Then
'Affiche la boîte de dialogue MS Office FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
Tu n'as pas bien noté mon explication d'hier :
*** La méthode oDialog.Show renvoie 0 (zéro) si l'opération a été
annulée ***
Hors dans ton code tu continues, il faut donc que tu positionnes
l'arrêt de ta procédure à ce niveau :
If oDialog.Show = 0 Then
Msgbox "Opération annulée", vbExclamation, "Pas d'importation à partir
d 'Excel"
xlApp.Quit
Set xlApp = Nothing
Exit sub
Else
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'ensuite tu positionnes le reste de tes opérations ici
'et tu n'oublies pas de positionner à la fin :
End If
3°) If NomClasseurXL = "" Then
Ceci n'a pas d'intérêt puisque tu effectues déjà ton contrôle
auparavant avec If oDialog.Show = 0
4°) Je vois d'autres choses et plus particulièrement je te conseillerai
de travailler sur une gestion d'erreur globale (même si tu évoques un
If Err.Number = 1004 qui ne me paraît pas nécessaire - tu as déjà fait
ton contrôle précédement ! et de toute façon c'est mal positionné)
Sinon, tu répètes dans ton code l'affectation de la propriété Visible à
False pour XLApp, ça me paraît inutile (dans la partie commençant par
With XLApp).
Je ne peux pas tester ta procédure pour la suite, je ne possède pas
MSProject, mais tu devrais avancer un peu quand même avec ces
suggestions.
Cordialement
Pascal
"Woody" a écrit dans le message de news:Bonjour Pascal,
Voici le code incriminé!
Merci pour ton aide
Sub ImportationExcel_3c()
'Dans Art Gr DT Bis.mpp
Dim XLApp As Excel.Application 'La référence par variable à liaison
précoce offre de meilleures performances, mais ne peut contenir qu'une
référence à la classe indiquée dans la déclaration.
Dim Chemin As String, Clic As Integer
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
'Application.ScreenUpdating = False 'Fige l'affichage écran
'Set XLApp = New Excel.Application 'Exige une Référence sur une
version d'Excel
Set XLApp = CreateObject("Excel.Application") 'Va chercher le Excel
qui figure dans la Base de registre, quelque soit sa version,
'mais ne présente plus d'aide à la synthaxe.
XLApp.Visible = False
'ChDrive "D" '"D:Mes documentsDT a traiter"
'Chemin = "D:Mes documentsDT a traiter" 'Inutile avec la boîte de
dialogue msoFileDialogFilePicker
'ChDir Chemin 'Modifie le répertoire
par défaut
'NB : La boîte de dialogue msoFileDialogFilePicker n'utilise pas le
dossier par défaut,
'mais ce qui est spécifié dans Excel comme répertoire de démarrage
'NomClasseurXL = InputBox("Nom du classeur Excel :", "Importation des
données Excel", "Demande Opération 1.xls")
Dim oDialog As Office.FileDialog 'Create
a FileDialog object
'Create a FileDialog object as a File Picker dialog box:
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker) 'Ouvre
une boîte de dialogue MS Office FilePicker : 'Create a FileDialog
object as a File Picker dialog box.
oDialog.InitialFileName = "D:Mes documentsDT a traiter" 'Set
the initial path to the D: drive.
oDialog.Filters.Add "Fichiers Excel", "*.xls" 'Sélection sur les
classeurs .XLS
oDialog.Title = "Sélectionnez le fichier Excel" 'Titre
de la boîte de dialogue
oDialog.AllowMultiSelect = False 'Pas de
sélection multiple
If oDialog.Show = 0 Then 'Affiche la boîte de dialogue MS Office
FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'MsgBox "Le classeur Excel sélectionné est : " &
NomClasseurXL 'Empêche la fermeture de la fenêtre Excel
End If
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à
partir d'Excel"
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet
XL
Exit Sub
End If
Set oDialog = Nothing
If NomClasseurXL = "" Then 'Si l'opérateur n'a rien
sélectionné
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub 'on quitte la procédure
End If
XLApp.WorkBooks.Open NomClasseurXL
XLApp.Visible = False
With XLApp
'.Workbooks.Open FileName:=NomClasseurXL 'Ouvre le Classeur
voulu
'MsgBox "Erreur N° : " & Err.Number & " " & Err.Description
'Erreurs récupérables
If Err.Number = 1004 Then 'Fichier n'existe
pas
MsgBox "Erreur sur le nom du classeur Excel ou sur le chemin
d'accès"
Exit Sub
End If
'.WindowState = xlMinimized 'Réduit la fenêtre XL
(mais la réaffiche)
.Visible = False 'True 'Fenêtre
invisible/visible
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
Clic = MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import
des données Excel")
If Clic = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
NomTache = .Range("DTimpr!MSPTache").Rows(1).Value 'Lit le
champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=NomTache, TaskID:=1 'Dépose
le nom de la tâche qui figure dans le champ "DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
'EnterpriseTaskOutlineCode1
End With
'Application.ScreenUpdating = True
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
XLApp.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur
sans sauvegarde !
XLApp.Quit
Set XLApp = Nothing
End Sub
Woody
Je viens de faire un test sur un projet "bidon".
Avec le code suivant, et donc malgré les précautions prises dans le code
j'ai effectivement une apparition d'Excel mais elle est vraiment **très
furtive**.
Honnêtement je ne pense pas pouvoir faire beaucoup mieux, il semble qu'il
y ait un échange entre les deux applis que l'on ne peut pas maîtriser
totalement ?
Cordialement
Pascal
Sub ImportationExcel_3c()
Dim XLApp As Object
Dim Chemin As String
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
Set XLApp = CreateObject("Excel.Application")
Dim oDialog As Office.FileDialog
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker)
With oDialog
.InitialFileName = "D:Mes documentsDT a traiter"
.Filters.Add "Fichiers Excel", "*.xls"
.Title = "Sélectionnez le fichier Excel"
.AllowMultiSelect = False
If .Show = 0 Then
MsgBox "Opération annulée", vbExclamation, "Pas
d'importation à partir d 'Excel"
XLApp.Quit
Set XLApp = Nothing
Set oDialog = Nothing
Exit Sub
Else
NomClasseurXL = oDialog.SelectedItems(1)
Set oDialog = Nothing
End If
End With
With XLApp
.Visible = False
.WorkBooks.Open NomClasseurXL
.WindowState = -4140
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
If MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import des
données Excel") = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
'Lit le'champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=.Range("DTimpr!MSPTache").Value,
TaskID:=1 'Dépose le 'nom de la tâche qui figure dans le champ
"DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"),TaskID:=1
'SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1 'EnterpriseTaskOutlineCode1
.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur sans
sauvegarde !
.Quit
End With
Set XLApp = Nothing
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
End Sub
"papou" <cpapounospamthanx@laposte.netnospamthanks> a écrit dans le
message de news: %23RSVurhFIHA.4956@TK2MSFTNGP06.phx.gbl...
Rebonjour Woody
Chose promise chose due ;-)
Je viens d'installer MSProject.
Par contre comme je n'y connais pas grand chose pour l'instant, j'ai
quelques questions :
1 - Le code fonctionne t-il sur un projet vierge ?
2 - Quels sont les type de données attendus depuis la feuille Excel ?
(Les celllules avec les noms définis MSPTache, MSPNBoeuvre et
MSPdemandeur)
Sinon, une interrogation sur l'utilisation de
Range("DTimpr!MSPTache").Rows(1).Value
Avec un test complet, nous pourrons parvenir à ce que tu souhaites
j'espère.
Cordialement
Pascal
"Woody" <Woody@blackwood.net.invalid> a écrit dans le message de news:
OVPiQUXFIHA.2004@TK2MSFTNGP06.phx.gbl...
Pascal,
Merci pour tout ce travail de correction !
Je me suis appliqué à effectuer toutes les corrections suggérées (sauf
la gestion d'erreur globale que je n'ai pas encore faite). La procédure
fonctionne mais avec les deux inconvénients qui incriminent l'efficacité
du XLApp.Visible = False
- Si je clique OK dans la boite de dialog msoFileDialogFilePicker, la
fenêtre Excel apparaît une seconde puis disparaît. Le reste se passe
bien.
- Si je clique Annuler, la fenêtre Excel (vide) reste figée à l'écran.
Je dois la fermer manuellement pour accéder au
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à partir
d'Excel". Ensuite tout se passe normalement.
Quelque idée ?
Merci encore,
Woody
"papou" <cpapounospamthanx@laposte.netnospamthanks> a écrit dans le
message de news: OnpkesWFIHA.5228@TK2MSFTNGP05.phx.gbl...
Woody
Vite fait comme ça quelques problèmes :
1°) Dim xlApp As Excel.Application
Tu dois faire un choix (je crois d'ailleurs que je t'en avais déjà
touché un mot) :
Soit
Tu conserves ta déclaration telle quelle, alors tu dois utiliser la
méthode
Set XLApp = New Excel.Application
Où
Si tu utilises la méthode
Set XLApp = CreateObject("Excel.Application")
Alors tu modifies ta déclaration :
Dim xlApp As Object
2°) Ensuite :
If oDialog.Show = 0 Then
'Affiche la boîte de dialogue MS Office FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
Tu n'as pas bien noté mon explication d'hier :
*** La méthode oDialog.Show renvoie 0 (zéro) si l'opération a été
annulée ***
Hors dans ton code tu continues, il faut donc que tu positionnes
l'arrêt de ta procédure à ce niveau :
If oDialog.Show = 0 Then
Msgbox "Opération annulée", vbExclamation, "Pas d'importation à partir
d 'Excel"
xlApp.Quit
Set xlApp = Nothing
Exit sub
Else
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'ensuite tu positionnes le reste de tes opérations ici
'et tu n'oublies pas de positionner à la fin :
End If
3°) If NomClasseurXL = "" Then
Ceci n'a pas d'intérêt puisque tu effectues déjà ton contrôle
auparavant avec If oDialog.Show = 0
4°) Je vois d'autres choses et plus particulièrement je te conseillerai
de travailler sur une gestion d'erreur globale (même si tu évoques un
If Err.Number = 1004 qui ne me paraît pas nécessaire - tu as déjà fait
ton contrôle précédement ! et de toute façon c'est mal positionné)
Sinon, tu répètes dans ton code l'affectation de la propriété Visible à
False pour XLApp, ça me paraît inutile (dans la partie commençant par
With XLApp).
Je ne peux pas tester ta procédure pour la suite, je ne possède pas
MSProject, mais tu devrais avancer un peu quand même avec ces
suggestions.
Cordialement
Pascal
"Woody" <Woody@blackwood.net.invalid> a écrit dans le message de news:
eEbMZPWFIHA.1212@TK2MSFTNGP05.phx.gbl...
Bonjour Pascal,
Voici le code incriminé!
Merci pour ton aide
Sub ImportationExcel_3c()
'Dans Art Gr DT Bis.mpp
Dim XLApp As Excel.Application 'La référence par variable à liaison
précoce offre de meilleures performances, mais ne peut contenir qu'une
référence à la classe indiquée dans la déclaration.
Dim Chemin As String, Clic As Integer
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
'Application.ScreenUpdating = False 'Fige l'affichage écran
'Set XLApp = New Excel.Application 'Exige une Référence sur une
version d'Excel
Set XLApp = CreateObject("Excel.Application") 'Va chercher le Excel
qui figure dans la Base de registre, quelque soit sa version,
'mais ne présente plus d'aide à la synthaxe.
XLApp.Visible = False
'ChDrive "D" '"D:Mes documentsDT a traiter"
'Chemin = "D:Mes documentsDT a traiter" 'Inutile avec la boîte de
dialogue msoFileDialogFilePicker
'ChDir Chemin 'Modifie le répertoire
par défaut
'NB : La boîte de dialogue msoFileDialogFilePicker n'utilise pas le
dossier par défaut,
'mais ce qui est spécifié dans Excel comme répertoire de démarrage
'NomClasseurXL = InputBox("Nom du classeur Excel :", "Importation des
données Excel", "Demande Opération 1.xls")
Dim oDialog As Office.FileDialog 'Create
a FileDialog object
'Create a FileDialog object as a File Picker dialog box:
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker) 'Ouvre
une boîte de dialogue MS Office FilePicker : 'Create a FileDialog
object as a File Picker dialog box.
oDialog.InitialFileName = "D:Mes documentsDT a traiter" 'Set
the initial path to the D: drive.
oDialog.Filters.Add "Fichiers Excel", "*.xls" 'Sélection sur les
classeurs .XLS
oDialog.Title = "Sélectionnez le fichier Excel" 'Titre
de la boîte de dialogue
oDialog.AllowMultiSelect = False 'Pas de
sélection multiple
If oDialog.Show = 0 Then 'Affiche la boîte de dialogue MS Office
FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'MsgBox "Le classeur Excel sélectionné est : " &
NomClasseurXL 'Empêche la fermeture de la fenêtre Excel
End If
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à
partir d'Excel"
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet
XL
Exit Sub
End If
Set oDialog = Nothing
If NomClasseurXL = "" Then 'Si l'opérateur n'a rien
sélectionné
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub 'on quitte la procédure
End If
XLApp.WorkBooks.Open NomClasseurXL
XLApp.Visible = False
With XLApp
'.Workbooks.Open FileName:=NomClasseurXL 'Ouvre le Classeur
voulu
'MsgBox "Erreur N° : " & Err.Number & " " & Err.Description
'Erreurs récupérables
If Err.Number = 1004 Then 'Fichier n'existe
pas
MsgBox "Erreur sur le nom du classeur Excel ou sur le chemin
d'accès"
Exit Sub
End If
'.WindowState = xlMinimized 'Réduit la fenêtre XL
(mais la réaffiche)
.Visible = False 'True 'Fenêtre
invisible/visible
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
Clic = MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import
des données Excel")
If Clic = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
NomTache = .Range("DTimpr!MSPTache").Rows(1).Value 'Lit le
champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=NomTache, TaskID:=1 'Dépose
le nom de la tâche qui figure dans le champ "DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
'EnterpriseTaskOutlineCode1
End With
'Application.ScreenUpdating = True
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
XLApp.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur
sans sauvegarde !
XLApp.Quit
Set XLApp = Nothing
End Sub
Woody
Je viens de faire un test sur un projet "bidon".
Avec le code suivant, et donc malgré les précautions prises dans le code
j'ai effectivement une apparition d'Excel mais elle est vraiment **très
furtive**.
Honnêtement je ne pense pas pouvoir faire beaucoup mieux, il semble qu'il
y ait un échange entre les deux applis que l'on ne peut pas maîtriser
totalement ?
Cordialement
Pascal
Sub ImportationExcel_3c()
Dim XLApp As Object
Dim Chemin As String
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
Set XLApp = CreateObject("Excel.Application")
Dim oDialog As Office.FileDialog
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker)
With oDialog
.InitialFileName = "D:Mes documentsDT a traiter"
.Filters.Add "Fichiers Excel", "*.xls"
.Title = "Sélectionnez le fichier Excel"
.AllowMultiSelect = False
If .Show = 0 Then
MsgBox "Opération annulée", vbExclamation, "Pas
d'importation à partir d 'Excel"
XLApp.Quit
Set XLApp = Nothing
Set oDialog = Nothing
Exit Sub
Else
NomClasseurXL = oDialog.SelectedItems(1)
Set oDialog = Nothing
End If
End With
With XLApp
.Visible = False
.WorkBooks.Open NomClasseurXL
.WindowState = -4140
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
If MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import des
données Excel") = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
'Lit le'champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=.Range("DTimpr!MSPTache").Value,
TaskID:=1 'Dépose le 'nom de la tâche qui figure dans le champ
"DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"),TaskID:=1
'SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1 'EnterpriseTaskOutlineCode1
.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur sans
sauvegarde !
.Quit
End With
Set XLApp = Nothing
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
End Sub
"papou" a écrit dans le
message de news: %Rebonjour Woody
Chose promise chose due ;-)
Je viens d'installer MSProject.
Par contre comme je n'y connais pas grand chose pour l'instant, j'ai
quelques questions :
1 - Le code fonctionne t-il sur un projet vierge ?
2 - Quels sont les type de données attendus depuis la feuille Excel ?
(Les celllules avec les noms définis MSPTache, MSPNBoeuvre et
MSPdemandeur)
Sinon, une interrogation sur l'utilisation de
Range("DTimpr!MSPTache").Rows(1).Value
Avec un test complet, nous pourrons parvenir à ce que tu souhaites
j'espère.
Cordialement
Pascal
"Woody" a écrit dans le message de news:Pascal,
Merci pour tout ce travail de correction !
Je me suis appliqué à effectuer toutes les corrections suggérées (sauf
la gestion d'erreur globale que je n'ai pas encore faite). La procédure
fonctionne mais avec les deux inconvénients qui incriminent l'efficacité
du XLApp.Visible = False
- Si je clique OK dans la boite de dialog msoFileDialogFilePicker, la
fenêtre Excel apparaît une seconde puis disparaît. Le reste se passe
bien.
- Si je clique Annuler, la fenêtre Excel (vide) reste figée à l'écran.
Je dois la fermer manuellement pour accéder au
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à partir
d'Excel". Ensuite tout se passe normalement.
Quelque idée ?
Merci encore,
Woody
"papou" a écrit dans le
message de news:Woody
Vite fait comme ça quelques problèmes :
1°) Dim xlApp As Excel.Application
Tu dois faire un choix (je crois d'ailleurs que je t'en avais déjà
touché un mot) :
Soit
Tu conserves ta déclaration telle quelle, alors tu dois utiliser la
méthode
Set XLApp = New Excel.Application
Où
Si tu utilises la méthode
Set XLApp = CreateObject("Excel.Application")
Alors tu modifies ta déclaration :
Dim xlApp As Object
2°) Ensuite :
If oDialog.Show = 0 Then
'Affiche la boîte de dialogue MS Office FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
Tu n'as pas bien noté mon explication d'hier :
*** La méthode oDialog.Show renvoie 0 (zéro) si l'opération a été
annulée ***
Hors dans ton code tu continues, il faut donc que tu positionnes
l'arrêt de ta procédure à ce niveau :
If oDialog.Show = 0 Then
Msgbox "Opération annulée", vbExclamation, "Pas d'importation à partir
d 'Excel"
xlApp.Quit
Set xlApp = Nothing
Exit sub
Else
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'ensuite tu positionnes le reste de tes opérations ici
'et tu n'oublies pas de positionner à la fin :
End If
3°) If NomClasseurXL = "" Then
Ceci n'a pas d'intérêt puisque tu effectues déjà ton contrôle
auparavant avec If oDialog.Show = 0
4°) Je vois d'autres choses et plus particulièrement je te conseillerai
de travailler sur une gestion d'erreur globale (même si tu évoques un
If Err.Number = 1004 qui ne me paraît pas nécessaire - tu as déjà fait
ton contrôle précédement ! et de toute façon c'est mal positionné)
Sinon, tu répètes dans ton code l'affectation de la propriété Visible à
False pour XLApp, ça me paraît inutile (dans la partie commençant par
With XLApp).
Je ne peux pas tester ta procédure pour la suite, je ne possède pas
MSProject, mais tu devrais avancer un peu quand même avec ces
suggestions.
Cordialement
Pascal
"Woody" a écrit dans le message de news:Bonjour Pascal,
Voici le code incriminé!
Merci pour ton aide
Sub ImportationExcel_3c()
'Dans Art Gr DT Bis.mpp
Dim XLApp As Excel.Application 'La référence par variable à liaison
précoce offre de meilleures performances, mais ne peut contenir qu'une
référence à la classe indiquée dans la déclaration.
Dim Chemin As String, Clic As Integer
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
'Application.ScreenUpdating = False 'Fige l'affichage écran
'Set XLApp = New Excel.Application 'Exige une Référence sur une
version d'Excel
Set XLApp = CreateObject("Excel.Application") 'Va chercher le Excel
qui figure dans la Base de registre, quelque soit sa version,
'mais ne présente plus d'aide à la synthaxe.
XLApp.Visible = False
'ChDrive "D" '"D:Mes documentsDT a traiter"
'Chemin = "D:Mes documentsDT a traiter" 'Inutile avec la boîte de
dialogue msoFileDialogFilePicker
'ChDir Chemin 'Modifie le répertoire
par défaut
'NB : La boîte de dialogue msoFileDialogFilePicker n'utilise pas le
dossier par défaut,
'mais ce qui est spécifié dans Excel comme répertoire de démarrage
'NomClasseurXL = InputBox("Nom du classeur Excel :", "Importation des
données Excel", "Demande Opération 1.xls")
Dim oDialog As Office.FileDialog 'Create
a FileDialog object
'Create a FileDialog object as a File Picker dialog box:
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker) 'Ouvre
une boîte de dialogue MS Office FilePicker : 'Create a FileDialog
object as a File Picker dialog box.
oDialog.InitialFileName = "D:Mes documentsDT a traiter" 'Set
the initial path to the D: drive.
oDialog.Filters.Add "Fichiers Excel", "*.xls" 'Sélection sur les
classeurs .XLS
oDialog.Title = "Sélectionnez le fichier Excel" 'Titre
de la boîte de dialogue
oDialog.AllowMultiSelect = False 'Pas de
sélection multiple
If oDialog.Show = 0 Then 'Affiche la boîte de dialogue MS Office
FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'MsgBox "Le classeur Excel sélectionné est : " &
NomClasseurXL 'Empêche la fermeture de la fenêtre Excel
End If
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à
partir d'Excel"
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet
XL
Exit Sub
End If
Set oDialog = Nothing
If NomClasseurXL = "" Then 'Si l'opérateur n'a rien
sélectionné
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub 'on quitte la procédure
End If
XLApp.WorkBooks.Open NomClasseurXL
XLApp.Visible = False
With XLApp
'.Workbooks.Open FileName:=NomClasseurXL 'Ouvre le Classeur
voulu
'MsgBox "Erreur N° : " & Err.Number & " " & Err.Description
'Erreurs récupérables
If Err.Number = 1004 Then 'Fichier n'existe
pas
MsgBox "Erreur sur le nom du classeur Excel ou sur le chemin
d'accès"
Exit Sub
End If
'.WindowState = xlMinimized 'Réduit la fenêtre XL
(mais la réaffiche)
.Visible = False 'True 'Fenêtre
invisible/visible
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
Clic = MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import
des données Excel")
If Clic = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
NomTache = .Range("DTimpr!MSPTache").Rows(1).Value 'Lit le
champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=NomTache, TaskID:=1 'Dépose
le nom de la tâche qui figure dans le champ "DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
'EnterpriseTaskOutlineCode1
End With
'Application.ScreenUpdating = True
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
XLApp.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur
sans sauvegarde !
XLApp.Quit
Set XLApp = Nothing
End Sub
Woody
Dernier test concluant celui-ci - pour ce qui me concerne - en utilisant
une méthode différente pour l'ouverture du fichier.
A toi d'essayer !
Cordialement
Pascal
Sub ImportationExcel_3c()
Dim XLApp As Object
Dim Chemin As String
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
Set XLApp = CreateObject("Excel.Application")
Dim FicXl
'définir le chemin par défaut pour être directement dans le bon répertoire
XLApp.DefaultFilePath = "D:Mes documentsDT a traiter"
FicXl = XLApp.GetOpenFilename("Excel Files, *.xls", , "Sélectionnez le
fichier Excel")
'Op annulée
If FicXl = False Then
MsgBox "Opération annulée", vbExclamation, "Pas
d'importation à partir d 'Excel"
XLApp.Quit
Set XLApp = Nothing
Set FicXl = Nothing
Exit Sub
Else
NomClasseurXL = FicXl
End If
With XLApp
.Visible = False
.WorkBooks.Open NomClasseurXL
.WindowState = -4140
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
If MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import des
données Excel") = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
'Lit le'champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=.Range("DTimpr!MSPTache").Value,
TaskID:=1 'Dépose le 'nom de la tâche qui figure dans le champ
"DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"),TaskID:=1
'SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1 'EnterpriseTaskOutlineCode1
.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur sans
sauvegarde !
.Quit
End With
Set XLApp = Nothing
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
End Sub
"papou" a écrit dans le
message de news: %23%Woody
Je viens de faire un test sur un projet "bidon".
Avec le code suivant, et donc malgré les précautions prises dans le code
j'ai effectivement une apparition d'Excel mais elle est vraiment **très
furtive**.
Honnêtement je ne pense pas pouvoir faire beaucoup mieux, il semble qu'il
y ait un échange entre les deux applis que l'on ne peut pas maîtriser
totalement ?
Cordialement
Pascal
Sub ImportationExcel_3c()
Dim XLApp As Object
Dim Chemin As String
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
Set XLApp = CreateObject("Excel.Application")
Dim oDialog As Office.FileDialog
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker)
With oDialog
.InitialFileName = "D:Mes documentsDT a traiter"
.Filters.Add "Fichiers Excel", "*.xls"
.Title = "Sélectionnez le fichier Excel"
.AllowMultiSelect = False
If .Show = 0 Then
MsgBox "Opération annulée", vbExclamation, "Pas
d'importation à partir d 'Excel"
XLApp.Quit
Set XLApp = Nothing
Set oDialog = Nothing
Exit Sub
Else
NomClasseurXL = oDialog.SelectedItems(1)
Set oDialog = Nothing
End If
End With
With XLApp
.Visible = False
.WorkBooks.Open NomClasseurXL
.WindowState = -4140
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
If MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import
des données Excel") = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
'Lit le'champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=.Range("DTimpr!MSPTache").Value,
TaskID:=1 'Dépose le 'nom de la tâche qui figure dans le champ
"DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"),TaskID:=1
'SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1 'EnterpriseTaskOutlineCode1
.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur sans
sauvegarde !
.Quit
End With
Set XLApp = Nothing
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
End Sub
"papou" a écrit dans le
message de news: %Rebonjour Woody
Chose promise chose due ;-)
Je viens d'installer MSProject.
Par contre comme je n'y connais pas grand chose pour l'instant, j'ai
quelques questions :
1 - Le code fonctionne t-il sur un projet vierge ?
2 - Quels sont les type de données attendus depuis la feuille Excel ?
(Les celllules avec les noms définis MSPTache, MSPNBoeuvre et
MSPdemandeur)
Sinon, une interrogation sur l'utilisation de
Range("DTimpr!MSPTache").Rows(1).Value
Avec un test complet, nous pourrons parvenir à ce que tu souhaites
j'espère.
Cordialement
Pascal
"Woody" a écrit dans le message de news:Pascal,
Merci pour tout ce travail de correction !
Je me suis appliqué à effectuer toutes les corrections suggérées (sauf
la gestion d'erreur globale que je n'ai pas encore faite). La procédure
fonctionne mais avec les deux inconvénients qui incriminent
l'efficacité du XLApp.Visible = False
- Si je clique OK dans la boite de dialog msoFileDialogFilePicker, la
fenêtre Excel apparaît une seconde puis disparaît. Le reste se passe
bien.
- Si je clique Annuler, la fenêtre Excel (vide) reste figée à l'écran.
Je dois la fermer manuellement pour accéder au
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à partir
d'Excel". Ensuite tout se passe normalement.
Quelque idée ?
Merci encore,
Woody
"papou" a écrit dans le
message de news:Woody
Vite fait comme ça quelques problèmes :
1°) Dim xlApp As Excel.Application
Tu dois faire un choix (je crois d'ailleurs que je t'en avais déjà
touché un mot) :
Soit
Tu conserves ta déclaration telle quelle, alors tu dois utiliser la
méthode
Set XLApp = New Excel.Application
Où
Si tu utilises la méthode
Set XLApp = CreateObject("Excel.Application")
Alors tu modifies ta déclaration :
Dim xlApp As Object
2°) Ensuite :
If oDialog.Show = 0 Then
'Affiche la boîte de dialogue MS Office FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
Tu n'as pas bien noté mon explication d'hier :
*** La méthode oDialog.Show renvoie 0 (zéro) si l'opération a été
annulée ***
Hors dans ton code tu continues, il faut donc que tu positionnes
l'arrêt de ta procédure à ce niveau :
If oDialog.Show = 0 Then
Msgbox "Opération annulée", vbExclamation, "Pas d'importation à partir
d 'Excel"
xlApp.Quit
Set xlApp = Nothing
Exit sub
Else
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'ensuite tu positionnes le reste de tes opérations ici
'et tu n'oublies pas de positionner à la fin :
End If
3°) If NomClasseurXL = "" Then
Ceci n'a pas d'intérêt puisque tu effectues déjà ton contrôle
auparavant avec If oDialog.Show = 0
4°) Je vois d'autres choses et plus particulièrement je te
conseillerai de travailler sur une gestion d'erreur globale (même si
tu évoques un If Err.Number = 1004 qui ne me paraît pas nécessaire -
tu as déjà fait ton contrôle précédement ! et de toute façon c'est mal
positionné)
Sinon, tu répètes dans ton code l'affectation de la propriété Visible
à False pour XLApp, ça me paraît inutile (dans la partie commençant
par With XLApp).
Je ne peux pas tester ta procédure pour la suite, je ne possède pas
MSProject, mais tu devrais avancer un peu quand même avec ces
suggestions.
Cordialement
Pascal
"Woody" a écrit dans le message de news:Bonjour Pascal,
Voici le code incriminé!
Merci pour ton aide
Sub ImportationExcel_3c()
'Dans Art Gr DT Bis.mpp
Dim XLApp As Excel.Application 'La référence par variable à liaison
précoce offre de meilleures performances, mais ne peut contenir
qu'une référence à la classe indiquée dans la déclaration.
Dim Chemin As String, Clic As Integer
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
'Application.ScreenUpdating = False 'Fige l'affichage écran
'Set XLApp = New Excel.Application 'Exige une Référence sur une
version d'Excel
Set XLApp = CreateObject("Excel.Application") 'Va chercher le Excel
qui figure dans la Base de registre, quelque soit sa version,
'mais ne présente plus d'aide à la synthaxe.
XLApp.Visible = False
'ChDrive "D" '"D:Mes documentsDT a traiter"
'Chemin = "D:Mes documentsDT a traiter" 'Inutile avec la boîte
de dialogue msoFileDialogFilePicker
'ChDir Chemin 'Modifie le répertoire
par défaut
'NB : La boîte de dialogue msoFileDialogFilePicker n'utilise pas le
dossier par défaut,
'mais ce qui est spécifié dans Excel comme répertoire de démarrage
'NomClasseurXL = InputBox("Nom du classeur Excel :", "Importation des
données Excel", "Demande Opération 1.xls")
Dim oDialog As Office.FileDialog
'Create a FileDialog object
'Create a FileDialog object as a File Picker dialog box:
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker) 'Ouvre
une boîte de dialogue MS Office FilePicker : 'Create a FileDialog
object as a File Picker dialog box.
oDialog.InitialFileName = "D:Mes documentsDT a traiter" 'Set
the initial path to the D: drive.
oDialog.Filters.Add "Fichiers Excel", "*.xls" 'Sélection sur les
classeurs .XLS
oDialog.Title = "Sélectionnez le fichier Excel" 'Titre
de la boîte de dialogue
oDialog.AllowMultiSelect = False 'Pas
de sélection multiple
If oDialog.Show = 0 Then 'Affiche la boîte de dialogue MS Office
FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'MsgBox "Le classeur Excel sélectionné est : " &
NomClasseurXL 'Empêche la fermeture de la fenêtre Excel
End If
MsgBox "Opération annulée", vbExclamation, "Pas d'importation
à partir d'Excel"
XLApp.Quit 'on quitte l'application
XL
Set XLApp = Nothing 'on vide la variable objet
XL
Exit Sub
End If
Set oDialog = Nothing
If NomClasseurXL = "" Then 'Si l'opérateur n'a rien
sélectionné
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub 'on quitte la procédure
End If
XLApp.WorkBooks.Open NomClasseurXL
XLApp.Visible = False
With XLApp
'.Workbooks.Open FileName:=NomClasseurXL 'Ouvre le Classeur
voulu
'MsgBox "Erreur N° : " & Err.Number & " " & Err.Description
'Erreurs récupérables
If Err.Number = 1004 Then 'Fichier n'existe
pas
MsgBox "Erreur sur le nom du classeur Excel ou sur le chemin
d'accès"
Exit Sub
End If
'.WindowState = xlMinimized 'Réduit la fenêtre XL
(mais la réaffiche)
.Visible = False 'True 'Fenêtre
invisible/visible
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
Clic = MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo,
"Import des données Excel")
If Clic = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
NomTache = .Range("DTimpr!MSPTache").Rows(1).Value 'Lit
le champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=NomTache, TaskID:=1
'Dépose le nom de la tâche qui figure dans le champ "DTimpr!MSPTache"
SetTaskField Field:="Number3",
Value:=.Range("DTimpr!MSPNBoeuvre"), TaskID:=1 'Dépose le Nombre
d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
'EnterpriseTaskOutlineCode1
End With
'Application.ScreenUpdating = True
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
XLApp.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur
sans sauvegarde !
XLApp.Quit
Set XLApp = Nothing
End Sub
Woody
Dernier test concluant celui-ci - pour ce qui me concerne - en utilisant
une méthode différente pour l'ouverture du fichier.
A toi d'essayer !
Cordialement
Pascal
Sub ImportationExcel_3c()
Dim XLApp As Object
Dim Chemin As String
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
Set XLApp = CreateObject("Excel.Application")
Dim FicXl
'définir le chemin par défaut pour être directement dans le bon répertoire
XLApp.DefaultFilePath = "D:Mes documentsDT a traiter"
FicXl = XLApp.GetOpenFilename("Excel Files, *.xls", , "Sélectionnez le
fichier Excel")
'Op annulée
If FicXl = False Then
MsgBox "Opération annulée", vbExclamation, "Pas
d'importation à partir d 'Excel"
XLApp.Quit
Set XLApp = Nothing
Set FicXl = Nothing
Exit Sub
Else
NomClasseurXL = FicXl
End If
With XLApp
.Visible = False
.WorkBooks.Open NomClasseurXL
.WindowState = -4140
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
If MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import des
données Excel") = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
'Lit le'champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=.Range("DTimpr!MSPTache").Value,
TaskID:=1 'Dépose le 'nom de la tâche qui figure dans le champ
"DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"),TaskID:=1
'SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1 'EnterpriseTaskOutlineCode1
.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur sans
sauvegarde !
.Quit
End With
Set XLApp = Nothing
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
End Sub
"papou" <cpapounospamthanx@laposte.netnospamthanks> a écrit dans le
message de news: %23%23yXyIiFIHA.536@TK2MSFTNGP06.phx.gbl...
Woody
Je viens de faire un test sur un projet "bidon".
Avec le code suivant, et donc malgré les précautions prises dans le code
j'ai effectivement une apparition d'Excel mais elle est vraiment **très
furtive**.
Honnêtement je ne pense pas pouvoir faire beaucoup mieux, il semble qu'il
y ait un échange entre les deux applis que l'on ne peut pas maîtriser
totalement ?
Cordialement
Pascal
Sub ImportationExcel_3c()
Dim XLApp As Object
Dim Chemin As String
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
Set XLApp = CreateObject("Excel.Application")
Dim oDialog As Office.FileDialog
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker)
With oDialog
.InitialFileName = "D:Mes documentsDT a traiter"
.Filters.Add "Fichiers Excel", "*.xls"
.Title = "Sélectionnez le fichier Excel"
.AllowMultiSelect = False
If .Show = 0 Then
MsgBox "Opération annulée", vbExclamation, "Pas
d'importation à partir d 'Excel"
XLApp.Quit
Set XLApp = Nothing
Set oDialog = Nothing
Exit Sub
Else
NomClasseurXL = oDialog.SelectedItems(1)
Set oDialog = Nothing
End If
End With
With XLApp
.Visible = False
.WorkBooks.Open NomClasseurXL
.WindowState = -4140
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
If MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import
des données Excel") = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
'Lit le'champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=.Range("DTimpr!MSPTache").Value,
TaskID:=1 'Dépose le 'nom de la tâche qui figure dans le champ
"DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"),TaskID:=1
'SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1 'EnterpriseTaskOutlineCode1
.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur sans
sauvegarde !
.Quit
End With
Set XLApp = Nothing
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
End Sub
"papou" <cpapounospamthanx@laposte.netnospamthanks> a écrit dans le
message de news: %23RSVurhFIHA.4956@TK2MSFTNGP06.phx.gbl...
Rebonjour Woody
Chose promise chose due ;-)
Je viens d'installer MSProject.
Par contre comme je n'y connais pas grand chose pour l'instant, j'ai
quelques questions :
1 - Le code fonctionne t-il sur un projet vierge ?
2 - Quels sont les type de données attendus depuis la feuille Excel ?
(Les celllules avec les noms définis MSPTache, MSPNBoeuvre et
MSPdemandeur)
Sinon, une interrogation sur l'utilisation de
Range("DTimpr!MSPTache").Rows(1).Value
Avec un test complet, nous pourrons parvenir à ce que tu souhaites
j'espère.
Cordialement
Pascal
"Woody" <Woody@blackwood.net.invalid> a écrit dans le message de news:
OVPiQUXFIHA.2004@TK2MSFTNGP06.phx.gbl...
Pascal,
Merci pour tout ce travail de correction !
Je me suis appliqué à effectuer toutes les corrections suggérées (sauf
la gestion d'erreur globale que je n'ai pas encore faite). La procédure
fonctionne mais avec les deux inconvénients qui incriminent
l'efficacité du XLApp.Visible = False
- Si je clique OK dans la boite de dialog msoFileDialogFilePicker, la
fenêtre Excel apparaît une seconde puis disparaît. Le reste se passe
bien.
- Si je clique Annuler, la fenêtre Excel (vide) reste figée à l'écran.
Je dois la fermer manuellement pour accéder au
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à partir
d'Excel". Ensuite tout se passe normalement.
Quelque idée ?
Merci encore,
Woody
"papou" <cpapounospamthanx@laposte.netnospamthanks> a écrit dans le
message de news: OnpkesWFIHA.5228@TK2MSFTNGP05.phx.gbl...
Woody
Vite fait comme ça quelques problèmes :
1°) Dim xlApp As Excel.Application
Tu dois faire un choix (je crois d'ailleurs que je t'en avais déjà
touché un mot) :
Soit
Tu conserves ta déclaration telle quelle, alors tu dois utiliser la
méthode
Set XLApp = New Excel.Application
Où
Si tu utilises la méthode
Set XLApp = CreateObject("Excel.Application")
Alors tu modifies ta déclaration :
Dim xlApp As Object
2°) Ensuite :
If oDialog.Show = 0 Then
'Affiche la boîte de dialogue MS Office FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
Tu n'as pas bien noté mon explication d'hier :
*** La méthode oDialog.Show renvoie 0 (zéro) si l'opération a été
annulée ***
Hors dans ton code tu continues, il faut donc que tu positionnes
l'arrêt de ta procédure à ce niveau :
If oDialog.Show = 0 Then
Msgbox "Opération annulée", vbExclamation, "Pas d'importation à partir
d 'Excel"
xlApp.Quit
Set xlApp = Nothing
Exit sub
Else
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'ensuite tu positionnes le reste de tes opérations ici
'et tu n'oublies pas de positionner à la fin :
End If
3°) If NomClasseurXL = "" Then
Ceci n'a pas d'intérêt puisque tu effectues déjà ton contrôle
auparavant avec If oDialog.Show = 0
4°) Je vois d'autres choses et plus particulièrement je te
conseillerai de travailler sur une gestion d'erreur globale (même si
tu évoques un If Err.Number = 1004 qui ne me paraît pas nécessaire -
tu as déjà fait ton contrôle précédement ! et de toute façon c'est mal
positionné)
Sinon, tu répètes dans ton code l'affectation de la propriété Visible
à False pour XLApp, ça me paraît inutile (dans la partie commençant
par With XLApp).
Je ne peux pas tester ta procédure pour la suite, je ne possède pas
MSProject, mais tu devrais avancer un peu quand même avec ces
suggestions.
Cordialement
Pascal
"Woody" <Woody@blackwood.net.invalid> a écrit dans le message de news:
eEbMZPWFIHA.1212@TK2MSFTNGP05.phx.gbl...
Bonjour Pascal,
Voici le code incriminé!
Merci pour ton aide
Sub ImportationExcel_3c()
'Dans Art Gr DT Bis.mpp
Dim XLApp As Excel.Application 'La référence par variable à liaison
précoce offre de meilleures performances, mais ne peut contenir
qu'une référence à la classe indiquée dans la déclaration.
Dim Chemin As String, Clic As Integer
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
'Application.ScreenUpdating = False 'Fige l'affichage écran
'Set XLApp = New Excel.Application 'Exige une Référence sur une
version d'Excel
Set XLApp = CreateObject("Excel.Application") 'Va chercher le Excel
qui figure dans la Base de registre, quelque soit sa version,
'mais ne présente plus d'aide à la synthaxe.
XLApp.Visible = False
'ChDrive "D" '"D:Mes documentsDT a traiter"
'Chemin = "D:Mes documentsDT a traiter" 'Inutile avec la boîte
de dialogue msoFileDialogFilePicker
'ChDir Chemin 'Modifie le répertoire
par défaut
'NB : La boîte de dialogue msoFileDialogFilePicker n'utilise pas le
dossier par défaut,
'mais ce qui est spécifié dans Excel comme répertoire de démarrage
'NomClasseurXL = InputBox("Nom du classeur Excel :", "Importation des
données Excel", "Demande Opération 1.xls")
Dim oDialog As Office.FileDialog
'Create a FileDialog object
'Create a FileDialog object as a File Picker dialog box:
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker) 'Ouvre
une boîte de dialogue MS Office FilePicker : 'Create a FileDialog
object as a File Picker dialog box.
oDialog.InitialFileName = "D:Mes documentsDT a traiter" 'Set
the initial path to the D: drive.
oDialog.Filters.Add "Fichiers Excel", "*.xls" 'Sélection sur les
classeurs .XLS
oDialog.Title = "Sélectionnez le fichier Excel" 'Titre
de la boîte de dialogue
oDialog.AllowMultiSelect = False 'Pas
de sélection multiple
If oDialog.Show = 0 Then 'Affiche la boîte de dialogue MS Office
FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'MsgBox "Le classeur Excel sélectionné est : " &
NomClasseurXL 'Empêche la fermeture de la fenêtre Excel
End If
MsgBox "Opération annulée", vbExclamation, "Pas d'importation
à partir d'Excel"
XLApp.Quit 'on quitte l'application
XL
Set XLApp = Nothing 'on vide la variable objet
XL
Exit Sub
End If
Set oDialog = Nothing
If NomClasseurXL = "" Then 'Si l'opérateur n'a rien
sélectionné
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub 'on quitte la procédure
End If
XLApp.WorkBooks.Open NomClasseurXL
XLApp.Visible = False
With XLApp
'.Workbooks.Open FileName:=NomClasseurXL 'Ouvre le Classeur
voulu
'MsgBox "Erreur N° : " & Err.Number & " " & Err.Description
'Erreurs récupérables
If Err.Number = 1004 Then 'Fichier n'existe
pas
MsgBox "Erreur sur le nom du classeur Excel ou sur le chemin
d'accès"
Exit Sub
End If
'.WindowState = xlMinimized 'Réduit la fenêtre XL
(mais la réaffiche)
.Visible = False 'True 'Fenêtre
invisible/visible
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
Clic = MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo,
"Import des données Excel")
If Clic = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
NomTache = .Range("DTimpr!MSPTache").Rows(1).Value 'Lit
le champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=NomTache, TaskID:=1
'Dépose le nom de la tâche qui figure dans le champ "DTimpr!MSPTache"
SetTaskField Field:="Number3",
Value:=.Range("DTimpr!MSPNBoeuvre"), TaskID:=1 'Dépose le Nombre
d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
'EnterpriseTaskOutlineCode1
End With
'Application.ScreenUpdating = True
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
XLApp.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur
sans sauvegarde !
XLApp.Quit
Set XLApp = Nothing
End Sub
Woody
Dernier test concluant celui-ci - pour ce qui me concerne - en utilisant
une méthode différente pour l'ouverture du fichier.
A toi d'essayer !
Cordialement
Pascal
Sub ImportationExcel_3c()
Dim XLApp As Object
Dim Chemin As String
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
Set XLApp = CreateObject("Excel.Application")
Dim FicXl
'définir le chemin par défaut pour être directement dans le bon répertoire
XLApp.DefaultFilePath = "D:Mes documentsDT a traiter"
FicXl = XLApp.GetOpenFilename("Excel Files, *.xls", , "Sélectionnez le
fichier Excel")
'Op annulée
If FicXl = False Then
MsgBox "Opération annulée", vbExclamation, "Pas
d'importation à partir d 'Excel"
XLApp.Quit
Set XLApp = Nothing
Set FicXl = Nothing
Exit Sub
Else
NomClasseurXL = FicXl
End If
With XLApp
.Visible = False
.WorkBooks.Open NomClasseurXL
.WindowState = -4140
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
If MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import des
données Excel") = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
'Lit le'champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=.Range("DTimpr!MSPTache").Value,
TaskID:=1 'Dépose le 'nom de la tâche qui figure dans le champ
"DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"),TaskID:=1
'SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1 'EnterpriseTaskOutlineCode1
.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur sans
sauvegarde !
.Quit
End With
Set XLApp = Nothing
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
End Sub
"papou" a écrit dans le
message de news: %23%Woody
Je viens de faire un test sur un projet "bidon".
Avec le code suivant, et donc malgré les précautions prises dans le code
j'ai effectivement une apparition d'Excel mais elle est vraiment **très
furtive**.
Honnêtement je ne pense pas pouvoir faire beaucoup mieux, il semble qu'il
y ait un échange entre les deux applis que l'on ne peut pas maîtriser
totalement ?
Cordialement
Pascal
Sub ImportationExcel_3c()
Dim XLApp As Object
Dim Chemin As String
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
Set XLApp = CreateObject("Excel.Application")
Dim oDialog As Office.FileDialog
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker)
With oDialog
.InitialFileName = "D:Mes documentsDT a traiter"
.Filters.Add "Fichiers Excel", "*.xls"
.Title = "Sélectionnez le fichier Excel"
.AllowMultiSelect = False
If .Show = 0 Then
MsgBox "Opération annulée", vbExclamation, "Pas
d'importation à partir d 'Excel"
XLApp.Quit
Set XLApp = Nothing
Set oDialog = Nothing
Exit Sub
Else
NomClasseurXL = oDialog.SelectedItems(1)
Set oDialog = Nothing
End If
End With
With XLApp
.Visible = False
.WorkBooks.Open NomClasseurXL
.WindowState = -4140
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
If MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import
des données Excel") = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
'Lit le'champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=.Range("DTimpr!MSPTache").Value,
TaskID:=1 'Dépose le 'nom de la tâche qui figure dans le champ
"DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"),TaskID:=1
'SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1 'EnterpriseTaskOutlineCode1
.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur sans
sauvegarde !
.Quit
End With
Set XLApp = Nothing
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
End Sub
"papou" a écrit dans le
message de news: %Rebonjour Woody
Chose promise chose due ;-)
Je viens d'installer MSProject.
Par contre comme je n'y connais pas grand chose pour l'instant, j'ai
quelques questions :
1 - Le code fonctionne t-il sur un projet vierge ?
2 - Quels sont les type de données attendus depuis la feuille Excel ?
(Les celllules avec les noms définis MSPTache, MSPNBoeuvre et
MSPdemandeur)
Sinon, une interrogation sur l'utilisation de
Range("DTimpr!MSPTache").Rows(1).Value
Avec un test complet, nous pourrons parvenir à ce que tu souhaites
j'espère.
Cordialement
Pascal
"Woody" a écrit dans le message de news:Pascal,
Merci pour tout ce travail de correction !
Je me suis appliqué à effectuer toutes les corrections suggérées (sauf
la gestion d'erreur globale que je n'ai pas encore faite). La procédure
fonctionne mais avec les deux inconvénients qui incriminent
l'efficacité du XLApp.Visible = False
- Si je clique OK dans la boite de dialog msoFileDialogFilePicker, la
fenêtre Excel apparaît une seconde puis disparaît. Le reste se passe
bien.
- Si je clique Annuler, la fenêtre Excel (vide) reste figée à l'écran.
Je dois la fermer manuellement pour accéder au
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à partir
d'Excel". Ensuite tout se passe normalement.
Quelque idée ?
Merci encore,
Woody
"papou" a écrit dans le
message de news:Woody
Vite fait comme ça quelques problèmes :
1°) Dim xlApp As Excel.Application
Tu dois faire un choix (je crois d'ailleurs que je t'en avais déjà
touché un mot) :
Soit
Tu conserves ta déclaration telle quelle, alors tu dois utiliser la
méthode
Set XLApp = New Excel.Application
Où
Si tu utilises la méthode
Set XLApp = CreateObject("Excel.Application")
Alors tu modifies ta déclaration :
Dim xlApp As Object
2°) Ensuite :
If oDialog.Show = 0 Then
'Affiche la boîte de dialogue MS Office FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
Tu n'as pas bien noté mon explication d'hier :
*** La méthode oDialog.Show renvoie 0 (zéro) si l'opération a été
annulée ***
Hors dans ton code tu continues, il faut donc que tu positionnes
l'arrêt de ta procédure à ce niveau :
If oDialog.Show = 0 Then
Msgbox "Opération annulée", vbExclamation, "Pas d'importation à partir
d 'Excel"
xlApp.Quit
Set xlApp = Nothing
Exit sub
Else
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'ensuite tu positionnes le reste de tes opérations ici
'et tu n'oublies pas de positionner à la fin :
End If
3°) If NomClasseurXL = "" Then
Ceci n'a pas d'intérêt puisque tu effectues déjà ton contrôle
auparavant avec If oDialog.Show = 0
4°) Je vois d'autres choses et plus particulièrement je te
conseillerai de travailler sur une gestion d'erreur globale (même si
tu évoques un If Err.Number = 1004 qui ne me paraît pas nécessaire -
tu as déjà fait ton contrôle précédement ! et de toute façon c'est mal
positionné)
Sinon, tu répètes dans ton code l'affectation de la propriété Visible
à False pour XLApp, ça me paraît inutile (dans la partie commençant
par With XLApp).
Je ne peux pas tester ta procédure pour la suite, je ne possède pas
MSProject, mais tu devrais avancer un peu quand même avec ces
suggestions.
Cordialement
Pascal
"Woody" a écrit dans le message de news:Bonjour Pascal,
Voici le code incriminé!
Merci pour ton aide
Sub ImportationExcel_3c()
'Dans Art Gr DT Bis.mpp
Dim XLApp As Excel.Application 'La référence par variable à liaison
précoce offre de meilleures performances, mais ne peut contenir
qu'une référence à la classe indiquée dans la déclaration.
Dim Chemin As String, Clic As Integer
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
'Application.ScreenUpdating = False 'Fige l'affichage écran
'Set XLApp = New Excel.Application 'Exige une Référence sur une
version d'Excel
Set XLApp = CreateObject("Excel.Application") 'Va chercher le Excel
qui figure dans la Base de registre, quelque soit sa version,
'mais ne présente plus d'aide à la synthaxe.
XLApp.Visible = False
'ChDrive "D" '"D:Mes documentsDT a traiter"
'Chemin = "D:Mes documentsDT a traiter" 'Inutile avec la boîte
de dialogue msoFileDialogFilePicker
'ChDir Chemin 'Modifie le répertoire
par défaut
'NB : La boîte de dialogue msoFileDialogFilePicker n'utilise pas le
dossier par défaut,
'mais ce qui est spécifié dans Excel comme répertoire de démarrage
'NomClasseurXL = InputBox("Nom du classeur Excel :", "Importation des
données Excel", "Demande Opération 1.xls")
Dim oDialog As Office.FileDialog
'Create a FileDialog object
'Create a FileDialog object as a File Picker dialog box:
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker) 'Ouvre
une boîte de dialogue MS Office FilePicker : 'Create a FileDialog
object as a File Picker dialog box.
oDialog.InitialFileName = "D:Mes documentsDT a traiter" 'Set
the initial path to the D: drive.
oDialog.Filters.Add "Fichiers Excel", "*.xls" 'Sélection sur les
classeurs .XLS
oDialog.Title = "Sélectionnez le fichier Excel" 'Titre
de la boîte de dialogue
oDialog.AllowMultiSelect = False 'Pas
de sélection multiple
If oDialog.Show = 0 Then 'Affiche la boîte de dialogue MS Office
FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'MsgBox "Le classeur Excel sélectionné est : " &
NomClasseurXL 'Empêche la fermeture de la fenêtre Excel
End If
MsgBox "Opération annulée", vbExclamation, "Pas d'importation
à partir d'Excel"
XLApp.Quit 'on quitte l'application
XL
Set XLApp = Nothing 'on vide la variable objet
XL
Exit Sub
End If
Set oDialog = Nothing
If NomClasseurXL = "" Then 'Si l'opérateur n'a rien
sélectionné
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub 'on quitte la procédure
End If
XLApp.WorkBooks.Open NomClasseurXL
XLApp.Visible = False
With XLApp
'.Workbooks.Open FileName:=NomClasseurXL 'Ouvre le Classeur
voulu
'MsgBox "Erreur N° : " & Err.Number & " " & Err.Description
'Erreurs récupérables
If Err.Number = 1004 Then 'Fichier n'existe
pas
MsgBox "Erreur sur le nom du classeur Excel ou sur le chemin
d'accès"
Exit Sub
End If
'.WindowState = xlMinimized 'Réduit la fenêtre XL
(mais la réaffiche)
.Visible = False 'True 'Fenêtre
invisible/visible
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
Clic = MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo,
"Import des données Excel")
If Clic = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
NomTache = .Range("DTimpr!MSPTache").Rows(1).Value 'Lit
le champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=NomTache, TaskID:=1
'Dépose le nom de la tâche qui figure dans le champ "DTimpr!MSPTache"
SetTaskField Field:="Number3",
Value:=.Range("DTimpr!MSPNBoeuvre"), TaskID:=1 'Dépose le Nombre
d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
'EnterpriseTaskOutlineCode1
End With
'Application.ScreenUpdating = True
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
XLApp.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur
sans sauvegarde !
XLApp.Quit
Set XLApp = Nothing
End Sub
Vraiment merci Pascal,
Cette méthode GetOpenFilename, pour sélectionner un fichier Excel,
fonctionne parfaitement et Excel reste complètement invisible ! Génial !
Encore merci pour tout !
Bonne journée,
Woody
"papou" a écrit dans le
message de news:Woody
Dernier test concluant celui-ci - pour ce qui me concerne - en utilisant
une méthode différente pour l'ouverture du fichier.
A toi d'essayer !
Cordialement
Pascal
Sub ImportationExcel_3c()
Dim XLApp As Object
Dim Chemin As String
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
Set XLApp = CreateObject("Excel.Application")
Dim FicXl
'définir le chemin par défaut pour être directement dans le bon
répertoire
XLApp.DefaultFilePath = "D:Mes documentsDT a traiter"
FicXl = XLApp.GetOpenFilename("Excel Files, *.xls", , "Sélectionnez le
fichier Excel")
'Op annulée
If FicXl = False Then
MsgBox "Opération annulée", vbExclamation, "Pas
d'importation à partir d 'Excel"
XLApp.Quit
Set XLApp = Nothing
Set FicXl = Nothing
Exit Sub
Else
NomClasseurXL = FicXl
End If
With XLApp
.Visible = False
.WorkBooks.Open NomClasseurXL
.WindowState = -4140
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
If MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import
des données Excel") = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
'Lit le'champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=.Range("DTimpr!MSPTache").Value,
TaskID:=1 'Dépose le 'nom de la tâche qui figure dans le champ
"DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"),TaskID:=1
'SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1 'EnterpriseTaskOutlineCode1
.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur sans
sauvegarde !
.Quit
End With
Set XLApp = Nothing
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
End Sub
"papou" a écrit dans le
message de news: %23%Woody
Je viens de faire un test sur un projet "bidon".
Avec le code suivant, et donc malgré les précautions prises dans le code
j'ai effectivement une apparition d'Excel mais elle est vraiment **très
furtive**.
Honnêtement je ne pense pas pouvoir faire beaucoup mieux, il semble
qu'il y ait un échange entre les deux applis que l'on ne peut pas
maîtriser totalement ?
Cordialement
Pascal
Sub ImportationExcel_3c()
Dim XLApp As Object
Dim Chemin As String
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
Set XLApp = CreateObject("Excel.Application")
Dim oDialog As Office.FileDialog
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker)
With oDialog
.InitialFileName = "D:Mes documentsDT a traiter"
.Filters.Add "Fichiers Excel", "*.xls"
.Title = "Sélectionnez le fichier Excel"
.AllowMultiSelect = False
If .Show = 0 Then
MsgBox "Opération annulée", vbExclamation, "Pas
d'importation à partir d 'Excel"
XLApp.Quit
Set XLApp = Nothing
Set oDialog = Nothing
Exit Sub
Else
NomClasseurXL = oDialog.SelectedItems(1)
Set oDialog = Nothing
End If
End With
With XLApp
.Visible = False
.WorkBooks.Open NomClasseurXL
.WindowState = -4140
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
If MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import
des données Excel") = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
'Lit le'champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=.Range("DTimpr!MSPTache").Value,
TaskID:=1 'Dépose le 'nom de la tâche qui figure dans le champ
"DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"),TaskID:=1
'SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1 'EnterpriseTaskOutlineCode1
.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur sans
sauvegarde !
.Quit
End With
Set XLApp = Nothing
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
End Sub
"papou" a écrit dans le
message de news: %Rebonjour Woody
Chose promise chose due ;-)
Je viens d'installer MSProject.
Par contre comme je n'y connais pas grand chose pour l'instant, j'ai
quelques questions :
1 - Le code fonctionne t-il sur un projet vierge ?
2 - Quels sont les type de données attendus depuis la feuille Excel ?
(Les celllules avec les noms définis MSPTache, MSPNBoeuvre et
MSPdemandeur)
Sinon, une interrogation sur l'utilisation de
Range("DTimpr!MSPTache").Rows(1).Value
Avec un test complet, nous pourrons parvenir à ce que tu souhaites
j'espère.
Cordialement
Pascal
"Woody" a écrit dans le message de news:Pascal,
Merci pour tout ce travail de correction !
Je me suis appliqué à effectuer toutes les corrections suggérées (sauf
la gestion d'erreur globale que je n'ai pas encore faite). La
procédure fonctionne mais avec les deux inconvénients qui incriminent
l'efficacité du XLApp.Visible = False
- Si je clique OK dans la boite de dialog msoFileDialogFilePicker, la
fenêtre Excel apparaît une seconde puis disparaît. Le reste se passe
bien.
- Si je clique Annuler, la fenêtre Excel (vide) reste figée à l'écran.
Je dois la fermer manuellement pour accéder au
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à partir
d'Excel". Ensuite tout se passe normalement.
Quelque idée ?
Merci encore,
Woody
"papou" a écrit dans le
message de news:Woody
Vite fait comme ça quelques problèmes :
1°) Dim xlApp As Excel.Application
Tu dois faire un choix (je crois d'ailleurs que je t'en avais déjà
touché un mot) :
Soit
Tu conserves ta déclaration telle quelle, alors tu dois utiliser la
méthode
Set XLApp = New Excel.Application
Où
Si tu utilises la méthode
Set XLApp = CreateObject("Excel.Application")
Alors tu modifies ta déclaration :
Dim xlApp As Object
2°) Ensuite :
If oDialog.Show = 0 Then
'Affiche la boîte de dialogue MS Office FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
Tu n'as pas bien noté mon explication d'hier :
*** La méthode oDialog.Show renvoie 0 (zéro) si l'opération a été
annulée ***
Hors dans ton code tu continues, il faut donc que tu positionnes
l'arrêt de ta procédure à ce niveau :
If oDialog.Show = 0 Then
Msgbox "Opération annulée", vbExclamation, "Pas d'importation à
partir d 'Excel"
xlApp.Quit
Set xlApp = Nothing
Exit sub
Else
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'ensuite tu positionnes le reste de tes opérations ici
'et tu n'oublies pas de positionner à la fin :
End If
3°) If NomClasseurXL = "" Then
Ceci n'a pas d'intérêt puisque tu effectues déjà ton contrôle
auparavant avec If oDialog.Show = 0
4°) Je vois d'autres choses et plus particulièrement je te
conseillerai de travailler sur une gestion d'erreur globale (même si
tu évoques un If Err.Number = 1004 qui ne me paraît pas nécessaire -
tu as déjà fait ton contrôle précédement ! et de toute façon c'est
mal positionné)
Sinon, tu répètes dans ton code l'affectation de la propriété Visible
à False pour XLApp, ça me paraît inutile (dans la partie commençant
par With XLApp).
Je ne peux pas tester ta procédure pour la suite, je ne possède pas
MSProject, mais tu devrais avancer un peu quand même avec ces
suggestions.
Cordialement
Pascal
"Woody" a écrit dans le message de
news:Bonjour Pascal,
Voici le code incriminé!
Merci pour ton aide
Sub ImportationExcel_3c()
'Dans Art Gr DT Bis.mpp
Dim XLApp As Excel.Application 'La référence par variable à liaison
précoce offre de meilleures performances, mais ne peut contenir
qu'une référence à la classe indiquée dans la déclaration.
Dim Chemin As String, Clic As Integer
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
'Application.ScreenUpdating = False 'Fige l'affichage écran
'Set XLApp = New Excel.Application 'Exige une Référence sur une
version d'Excel
Set XLApp = CreateObject("Excel.Application") 'Va chercher le Excel
qui figure dans la Base de registre, quelque soit sa version,
'mais ne présente plus d'aide à la synthaxe.
XLApp.Visible = False
'ChDrive "D" '"D:Mes documentsDT a traiter"
'Chemin = "D:Mes documentsDT a traiter" 'Inutile avec la boîte
de dialogue msoFileDialogFilePicker
'ChDir Chemin 'Modifie le répertoire
par défaut
'NB : La boîte de dialogue msoFileDialogFilePicker n'utilise pas le
dossier par défaut,
'mais ce qui est spécifié dans Excel comme répertoire de démarrage
'NomClasseurXL = InputBox("Nom du classeur Excel :", "Importation
des données Excel", "Demande Opération 1.xls")
Dim oDialog As Office.FileDialog 'Create a FileDialog object
'Create a FileDialog object as a File Picker dialog box:
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker)
'Ouvre une boîte de dialogue MS Office FilePicker : 'Create a
FileDialog object as a File Picker dialog box.
oDialog.InitialFileName = "D:Mes documentsDT a traiter" 'Set
the initial path to the D: drive.
oDialog.Filters.Add "Fichiers Excel", "*.xls" 'Sélection sur les
classeurs .XLS
oDialog.Title = "Sélectionnez le fichier Excel"
'Titre de la boîte de dialogue
oDialog.AllowMultiSelect = False 'Pas
de sélection multiple
If oDialog.Show = 0 Then 'Affiche la boîte de dialogue MS Office
FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'MsgBox "Le classeur Excel sélectionné est : " &
NomClasseurXL 'Empêche la fermeture de la fenêtre Excel
End If
MsgBox "Opération annulée", vbExclamation, "Pas d'importation
à partir d'Excel"
XLApp.Quit 'on quitte l'application
XL
Set XLApp = Nothing 'on vide la variable
objet XL
Exit Sub
End If
Set oDialog = Nothing
If NomClasseurXL = "" Then 'Si l'opérateur n'a rien
sélectionné
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub 'on quitte la procédure
End If
XLApp.WorkBooks.Open NomClasseurXL
XLApp.Visible = False
With XLApp
'.Workbooks.Open FileName:=NomClasseurXL 'Ouvre le Classeur
voulu
'MsgBox "Erreur N° : " & Err.Number & " " & Err.Description
'Erreurs récupérables
If Err.Number = 1004 Then 'Fichier n'existe
pas
MsgBox "Erreur sur le nom du classeur Excel ou sur le chemin
d'accès"
Exit Sub
End If
'.WindowState = xlMinimized 'Réduit la fenêtre
XL (mais la réaffiche)
.Visible = False 'True 'Fenêtre
invisible/visible
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
Clic = MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo,
"Import des données Excel")
If Clic = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
NomTache = .Range("DTimpr!MSPTache").Rows(1).Value 'Lit
le champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=NomTache, TaskID:=1 'Dépose le
nom de la tâche qui figure dans le champ "DTimpr!MSPTache"
SetTaskField Field:="Number3",
Value:=.Range("DTimpr!MSPNBoeuvre"), TaskID:=1 'Dépose le Nombre
d'oeuvres
SetTaskField Field:="Text2",
Value:=.Range("DTimpr!MSPdemandeur"), TaskID:=1 'Dépose le nom du
demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
'EnterpriseTaskOutlineCode1
End With
'Application.ScreenUpdating = True
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
XLApp.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur
sans sauvegarde !
XLApp.Quit
Set XLApp = Nothing
End Sub
Vraiment merci Pascal,
Cette méthode GetOpenFilename, pour sélectionner un fichier Excel,
fonctionne parfaitement et Excel reste complètement invisible ! Génial !
Encore merci pour tout !
Bonne journée,
Woody
"papou" <cpapounospamthanx@laposte.netnospamthanks> a écrit dans le
message de news: u3wSy5iFIHA.1168@TK2MSFTNGP02.phx.gbl...
Woody
Dernier test concluant celui-ci - pour ce qui me concerne - en utilisant
une méthode différente pour l'ouverture du fichier.
A toi d'essayer !
Cordialement
Pascal
Sub ImportationExcel_3c()
Dim XLApp As Object
Dim Chemin As String
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
Set XLApp = CreateObject("Excel.Application")
Dim FicXl
'définir le chemin par défaut pour être directement dans le bon
répertoire
XLApp.DefaultFilePath = "D:Mes documentsDT a traiter"
FicXl = XLApp.GetOpenFilename("Excel Files, *.xls", , "Sélectionnez le
fichier Excel")
'Op annulée
If FicXl = False Then
MsgBox "Opération annulée", vbExclamation, "Pas
d'importation à partir d 'Excel"
XLApp.Quit
Set XLApp = Nothing
Set FicXl = Nothing
Exit Sub
Else
NomClasseurXL = FicXl
End If
With XLApp
.Visible = False
.WorkBooks.Open NomClasseurXL
.WindowState = -4140
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
If MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import
des données Excel") = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
'Lit le'champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=.Range("DTimpr!MSPTache").Value,
TaskID:=1 'Dépose le 'nom de la tâche qui figure dans le champ
"DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"),TaskID:=1
'SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1 'EnterpriseTaskOutlineCode1
.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur sans
sauvegarde !
.Quit
End With
Set XLApp = Nothing
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
End Sub
"papou" <cpapounospamthanx@laposte.netnospamthanks> a écrit dans le
message de news: %23%23yXyIiFIHA.536@TK2MSFTNGP06.phx.gbl...
Woody
Je viens de faire un test sur un projet "bidon".
Avec le code suivant, et donc malgré les précautions prises dans le code
j'ai effectivement une apparition d'Excel mais elle est vraiment **très
furtive**.
Honnêtement je ne pense pas pouvoir faire beaucoup mieux, il semble
qu'il y ait un échange entre les deux applis que l'on ne peut pas
maîtriser totalement ?
Cordialement
Pascal
Sub ImportationExcel_3c()
Dim XLApp As Object
Dim Chemin As String
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
Set XLApp = CreateObject("Excel.Application")
Dim oDialog As Office.FileDialog
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker)
With oDialog
.InitialFileName = "D:Mes documentsDT a traiter"
.Filters.Add "Fichiers Excel", "*.xls"
.Title = "Sélectionnez le fichier Excel"
.AllowMultiSelect = False
If .Show = 0 Then
MsgBox "Opération annulée", vbExclamation, "Pas
d'importation à partir d 'Excel"
XLApp.Quit
Set XLApp = Nothing
Set oDialog = Nothing
Exit Sub
Else
NomClasseurXL = oDialog.SelectedItems(1)
Set oDialog = Nothing
End If
End With
With XLApp
.Visible = False
.WorkBooks.Open NomClasseurXL
.WindowState = -4140
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
If MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import
des données Excel") = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
'Lit le'champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=.Range("DTimpr!MSPTache").Value,
TaskID:=1 'Dépose le 'nom de la tâche qui figure dans le champ
"DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"),TaskID:=1
'SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1 'EnterpriseTaskOutlineCode1
.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur sans
sauvegarde !
.Quit
End With
Set XLApp = Nothing
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
End Sub
"papou" <cpapounospamthanx@laposte.netnospamthanks> a écrit dans le
message de news: %23RSVurhFIHA.4956@TK2MSFTNGP06.phx.gbl...
Rebonjour Woody
Chose promise chose due ;-)
Je viens d'installer MSProject.
Par contre comme je n'y connais pas grand chose pour l'instant, j'ai
quelques questions :
1 - Le code fonctionne t-il sur un projet vierge ?
2 - Quels sont les type de données attendus depuis la feuille Excel ?
(Les celllules avec les noms définis MSPTache, MSPNBoeuvre et
MSPdemandeur)
Sinon, une interrogation sur l'utilisation de
Range("DTimpr!MSPTache").Rows(1).Value
Avec un test complet, nous pourrons parvenir à ce que tu souhaites
j'espère.
Cordialement
Pascal
"Woody" <Woody@blackwood.net.invalid> a écrit dans le message de news:
OVPiQUXFIHA.2004@TK2MSFTNGP06.phx.gbl...
Pascal,
Merci pour tout ce travail de correction !
Je me suis appliqué à effectuer toutes les corrections suggérées (sauf
la gestion d'erreur globale que je n'ai pas encore faite). La
procédure fonctionne mais avec les deux inconvénients qui incriminent
l'efficacité du XLApp.Visible = False
- Si je clique OK dans la boite de dialog msoFileDialogFilePicker, la
fenêtre Excel apparaît une seconde puis disparaît. Le reste se passe
bien.
- Si je clique Annuler, la fenêtre Excel (vide) reste figée à l'écran.
Je dois la fermer manuellement pour accéder au
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à partir
d'Excel". Ensuite tout se passe normalement.
Quelque idée ?
Merci encore,
Woody
"papou" <cpapounospamthanx@laposte.netnospamthanks> a écrit dans le
message de news: OnpkesWFIHA.5228@TK2MSFTNGP05.phx.gbl...
Woody
Vite fait comme ça quelques problèmes :
1°) Dim xlApp As Excel.Application
Tu dois faire un choix (je crois d'ailleurs que je t'en avais déjà
touché un mot) :
Soit
Tu conserves ta déclaration telle quelle, alors tu dois utiliser la
méthode
Set XLApp = New Excel.Application
Où
Si tu utilises la méthode
Set XLApp = CreateObject("Excel.Application")
Alors tu modifies ta déclaration :
Dim xlApp As Object
2°) Ensuite :
If oDialog.Show = 0 Then
'Affiche la boîte de dialogue MS Office FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
Tu n'as pas bien noté mon explication d'hier :
*** La méthode oDialog.Show renvoie 0 (zéro) si l'opération a été
annulée ***
Hors dans ton code tu continues, il faut donc que tu positionnes
l'arrêt de ta procédure à ce niveau :
If oDialog.Show = 0 Then
Msgbox "Opération annulée", vbExclamation, "Pas d'importation à
partir d 'Excel"
xlApp.Quit
Set xlApp = Nothing
Exit sub
Else
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'ensuite tu positionnes le reste de tes opérations ici
'et tu n'oublies pas de positionner à la fin :
End If
3°) If NomClasseurXL = "" Then
Ceci n'a pas d'intérêt puisque tu effectues déjà ton contrôle
auparavant avec If oDialog.Show = 0
4°) Je vois d'autres choses et plus particulièrement je te
conseillerai de travailler sur une gestion d'erreur globale (même si
tu évoques un If Err.Number = 1004 qui ne me paraît pas nécessaire -
tu as déjà fait ton contrôle précédement ! et de toute façon c'est
mal positionné)
Sinon, tu répètes dans ton code l'affectation de la propriété Visible
à False pour XLApp, ça me paraît inutile (dans la partie commençant
par With XLApp).
Je ne peux pas tester ta procédure pour la suite, je ne possède pas
MSProject, mais tu devrais avancer un peu quand même avec ces
suggestions.
Cordialement
Pascal
"Woody" <Woody@blackwood.net.invalid> a écrit dans le message de
news: eEbMZPWFIHA.1212@TK2MSFTNGP05.phx.gbl...
Bonjour Pascal,
Voici le code incriminé!
Merci pour ton aide
Sub ImportationExcel_3c()
'Dans Art Gr DT Bis.mpp
Dim XLApp As Excel.Application 'La référence par variable à liaison
précoce offre de meilleures performances, mais ne peut contenir
qu'une référence à la classe indiquée dans la déclaration.
Dim Chemin As String, Clic As Integer
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
'Application.ScreenUpdating = False 'Fige l'affichage écran
'Set XLApp = New Excel.Application 'Exige une Référence sur une
version d'Excel
Set XLApp = CreateObject("Excel.Application") 'Va chercher le Excel
qui figure dans la Base de registre, quelque soit sa version,
'mais ne présente plus d'aide à la synthaxe.
XLApp.Visible = False
'ChDrive "D" '"D:Mes documentsDT a traiter"
'Chemin = "D:Mes documentsDT a traiter" 'Inutile avec la boîte
de dialogue msoFileDialogFilePicker
'ChDir Chemin 'Modifie le répertoire
par défaut
'NB : La boîte de dialogue msoFileDialogFilePicker n'utilise pas le
dossier par défaut,
'mais ce qui est spécifié dans Excel comme répertoire de démarrage
'NomClasseurXL = InputBox("Nom du classeur Excel :", "Importation
des données Excel", "Demande Opération 1.xls")
Dim oDialog As Office.FileDialog 'Create a FileDialog object
'Create a FileDialog object as a File Picker dialog box:
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker)
'Ouvre une boîte de dialogue MS Office FilePicker : 'Create a
FileDialog object as a File Picker dialog box.
oDialog.InitialFileName = "D:Mes documentsDT a traiter" 'Set
the initial path to the D: drive.
oDialog.Filters.Add "Fichiers Excel", "*.xls" 'Sélection sur les
classeurs .XLS
oDialog.Title = "Sélectionnez le fichier Excel"
'Titre de la boîte de dialogue
oDialog.AllowMultiSelect = False 'Pas
de sélection multiple
If oDialog.Show = 0 Then 'Affiche la boîte de dialogue MS Office
FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'MsgBox "Le classeur Excel sélectionné est : " &
NomClasseurXL 'Empêche la fermeture de la fenêtre Excel
End If
MsgBox "Opération annulée", vbExclamation, "Pas d'importation
à partir d'Excel"
XLApp.Quit 'on quitte l'application
XL
Set XLApp = Nothing 'on vide la variable
objet XL
Exit Sub
End If
Set oDialog = Nothing
If NomClasseurXL = "" Then 'Si l'opérateur n'a rien
sélectionné
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub 'on quitte la procédure
End If
XLApp.WorkBooks.Open NomClasseurXL
XLApp.Visible = False
With XLApp
'.Workbooks.Open FileName:=NomClasseurXL 'Ouvre le Classeur
voulu
'MsgBox "Erreur N° : " & Err.Number & " " & Err.Description
'Erreurs récupérables
If Err.Number = 1004 Then 'Fichier n'existe
pas
MsgBox "Erreur sur le nom du classeur Excel ou sur le chemin
d'accès"
Exit Sub
End If
'.WindowState = xlMinimized 'Réduit la fenêtre
XL (mais la réaffiche)
.Visible = False 'True 'Fenêtre
invisible/visible
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
Clic = MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo,
"Import des données Excel")
If Clic = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
NomTache = .Range("DTimpr!MSPTache").Rows(1).Value 'Lit
le champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=NomTache, TaskID:=1 'Dépose le
nom de la tâche qui figure dans le champ "DTimpr!MSPTache"
SetTaskField Field:="Number3",
Value:=.Range("DTimpr!MSPNBoeuvre"), TaskID:=1 'Dépose le Nombre
d'oeuvres
SetTaskField Field:="Text2",
Value:=.Range("DTimpr!MSPdemandeur"), TaskID:=1 'Dépose le nom du
demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
'EnterpriseTaskOutlineCode1
End With
'Application.ScreenUpdating = True
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
XLApp.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur
sans sauvegarde !
XLApp.Quit
Set XLApp = Nothing
End Sub
Vraiment merci Pascal,
Cette méthode GetOpenFilename, pour sélectionner un fichier Excel,
fonctionne parfaitement et Excel reste complètement invisible ! Génial !
Encore merci pour tout !
Bonne journée,
Woody
"papou" a écrit dans le
message de news:Woody
Dernier test concluant celui-ci - pour ce qui me concerne - en utilisant
une méthode différente pour l'ouverture du fichier.
A toi d'essayer !
Cordialement
Pascal
Sub ImportationExcel_3c()
Dim XLApp As Object
Dim Chemin As String
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
Set XLApp = CreateObject("Excel.Application")
Dim FicXl
'définir le chemin par défaut pour être directement dans le bon
répertoire
XLApp.DefaultFilePath = "D:Mes documentsDT a traiter"
FicXl = XLApp.GetOpenFilename("Excel Files, *.xls", , "Sélectionnez le
fichier Excel")
'Op annulée
If FicXl = False Then
MsgBox "Opération annulée", vbExclamation, "Pas
d'importation à partir d 'Excel"
XLApp.Quit
Set XLApp = Nothing
Set FicXl = Nothing
Exit Sub
Else
NomClasseurXL = FicXl
End If
With XLApp
.Visible = False
.WorkBooks.Open NomClasseurXL
.WindowState = -4140
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
If MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import
des données Excel") = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
'Lit le'champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=.Range("DTimpr!MSPTache").Value,
TaskID:=1 'Dépose le 'nom de la tâche qui figure dans le champ
"DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"),TaskID:=1
'SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1 'EnterpriseTaskOutlineCode1
.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur sans
sauvegarde !
.Quit
End With
Set XLApp = Nothing
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
End Sub
"papou" a écrit dans le
message de news: %23%Woody
Je viens de faire un test sur un projet "bidon".
Avec le code suivant, et donc malgré les précautions prises dans le code
j'ai effectivement une apparition d'Excel mais elle est vraiment **très
furtive**.
Honnêtement je ne pense pas pouvoir faire beaucoup mieux, il semble
qu'il y ait un échange entre les deux applis que l'on ne peut pas
maîtriser totalement ?
Cordialement
Pascal
Sub ImportationExcel_3c()
Dim XLApp As Object
Dim Chemin As String
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
Set XLApp = CreateObject("Excel.Application")
Dim oDialog As Office.FileDialog
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker)
With oDialog
.InitialFileName = "D:Mes documentsDT a traiter"
.Filters.Add "Fichiers Excel", "*.xls"
.Title = "Sélectionnez le fichier Excel"
.AllowMultiSelect = False
If .Show = 0 Then
MsgBox "Opération annulée", vbExclamation, "Pas
d'importation à partir d 'Excel"
XLApp.Quit
Set XLApp = Nothing
Set oDialog = Nothing
Exit Sub
Else
NomClasseurXL = oDialog.SelectedItems(1)
Set oDialog = Nothing
End If
End With
With XLApp
.Visible = False
.WorkBooks.Open NomClasseurXL
.WindowState = -4140
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
If MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo, "Import
des données Excel") = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
'Lit le'champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=.Range("DTimpr!MSPTache").Value,
TaskID:=1 'Dépose le 'nom de la tâche qui figure dans le champ
"DTimpr!MSPTache"
SetTaskField Field:="Number3", Value:=.Range("DTimpr!MSPNBoeuvre"),
TaskID:=1 'Dépose le Nombre d'oeuvres
SetTaskField Field:="Text2", Value:=.Range("DTimpr!MSPdemandeur"),
TaskID:=1 'Dépose le nom du demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"),TaskID:=1
'SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1 'EnterpriseTaskOutlineCode1
.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur sans
sauvegarde !
.Quit
End With
Set XLApp = Nothing
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
End Sub
"papou" a écrit dans le
message de news: %Rebonjour Woody
Chose promise chose due ;-)
Je viens d'installer MSProject.
Par contre comme je n'y connais pas grand chose pour l'instant, j'ai
quelques questions :
1 - Le code fonctionne t-il sur un projet vierge ?
2 - Quels sont les type de données attendus depuis la feuille Excel ?
(Les celllules avec les noms définis MSPTache, MSPNBoeuvre et
MSPdemandeur)
Sinon, une interrogation sur l'utilisation de
Range("DTimpr!MSPTache").Rows(1).Value
Avec un test complet, nous pourrons parvenir à ce que tu souhaites
j'espère.
Cordialement
Pascal
"Woody" a écrit dans le message de news:Pascal,
Merci pour tout ce travail de correction !
Je me suis appliqué à effectuer toutes les corrections suggérées (sauf
la gestion d'erreur globale que je n'ai pas encore faite). La
procédure fonctionne mais avec les deux inconvénients qui incriminent
l'efficacité du XLApp.Visible = False
- Si je clique OK dans la boite de dialog msoFileDialogFilePicker, la
fenêtre Excel apparaît une seconde puis disparaît. Le reste se passe
bien.
- Si je clique Annuler, la fenêtre Excel (vide) reste figée à l'écran.
Je dois la fermer manuellement pour accéder au
MsgBox "Opération annulée", vbExclamation, "Pas d'importation à partir
d'Excel". Ensuite tout se passe normalement.
Quelque idée ?
Merci encore,
Woody
"papou" a écrit dans le
message de news:Woody
Vite fait comme ça quelques problèmes :
1°) Dim xlApp As Excel.Application
Tu dois faire un choix (je crois d'ailleurs que je t'en avais déjà
touché un mot) :
Soit
Tu conserves ta déclaration telle quelle, alors tu dois utiliser la
méthode
Set XLApp = New Excel.Application
Où
Si tu utilises la méthode
Set XLApp = CreateObject("Excel.Application")
Alors tu modifies ta déclaration :
Dim xlApp As Object
2°) Ensuite :
If oDialog.Show = 0 Then
'Affiche la boîte de dialogue MS Office FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
Tu n'as pas bien noté mon explication d'hier :
*** La méthode oDialog.Show renvoie 0 (zéro) si l'opération a été
annulée ***
Hors dans ton code tu continues, il faut donc que tu positionnes
l'arrêt de ta procédure à ce niveau :
If oDialog.Show = 0 Then
Msgbox "Opération annulée", vbExclamation, "Pas d'importation à
partir d 'Excel"
xlApp.Quit
Set xlApp = Nothing
Exit sub
Else
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'ensuite tu positionnes le reste de tes opérations ici
'et tu n'oublies pas de positionner à la fin :
End If
3°) If NomClasseurXL = "" Then
Ceci n'a pas d'intérêt puisque tu effectues déjà ton contrôle
auparavant avec If oDialog.Show = 0
4°) Je vois d'autres choses et plus particulièrement je te
conseillerai de travailler sur une gestion d'erreur globale (même si
tu évoques un If Err.Number = 1004 qui ne me paraît pas nécessaire -
tu as déjà fait ton contrôle précédement ! et de toute façon c'est
mal positionné)
Sinon, tu répètes dans ton code l'affectation de la propriété Visible
à False pour XLApp, ça me paraît inutile (dans la partie commençant
par With XLApp).
Je ne peux pas tester ta procédure pour la suite, je ne possède pas
MSProject, mais tu devrais avancer un peu quand même avec ces
suggestions.
Cordialement
Pascal
"Woody" a écrit dans le message de
news:Bonjour Pascal,
Voici le code incriminé!
Merci pour ton aide
Sub ImportationExcel_3c()
'Dans Art Gr DT Bis.mpp
Dim XLApp As Excel.Application 'La référence par variable à liaison
précoce offre de meilleures performances, mais ne peut contenir
qu'une référence à la classe indiquée dans la déclaration.
Dim Chemin As String, Clic As Integer
Dim NomClasseurXL As String, NomTache As String
Dim No As Integer
'Application.ScreenUpdating = False 'Fige l'affichage écran
'Set XLApp = New Excel.Application 'Exige une Référence sur une
version d'Excel
Set XLApp = CreateObject("Excel.Application") 'Va chercher le Excel
qui figure dans la Base de registre, quelque soit sa version,
'mais ne présente plus d'aide à la synthaxe.
XLApp.Visible = False
'ChDrive "D" '"D:Mes documentsDT a traiter"
'Chemin = "D:Mes documentsDT a traiter" 'Inutile avec la boîte
de dialogue msoFileDialogFilePicker
'ChDir Chemin 'Modifie le répertoire
par défaut
'NB : La boîte de dialogue msoFileDialogFilePicker n'utilise pas le
dossier par défaut,
'mais ce qui est spécifié dans Excel comme répertoire de démarrage
'NomClasseurXL = InputBox("Nom du classeur Excel :", "Importation
des données Excel", "Demande Opération 1.xls")
Dim oDialog As Office.FileDialog 'Create a FileDialog object
'Create a FileDialog object as a File Picker dialog box:
Set oDialog = XLApp.FileDialog(msoFileDialogFilePicker)
'Ouvre une boîte de dialogue MS Office FilePicker : 'Create a
FileDialog object as a File Picker dialog box.
oDialog.InitialFileName = "D:Mes documentsDT a traiter" 'Set
the initial path to the D: drive.
oDialog.Filters.Add "Fichiers Excel", "*.xls" 'Sélection sur les
classeurs .XLS
oDialog.Title = "Sélectionnez le fichier Excel"
'Titre de la boîte de dialogue
oDialog.AllowMultiSelect = False 'Pas
de sélection multiple
If oDialog.Show = 0 Then 'Affiche la boîte de dialogue MS Office
FilePicker
If oDialog.SelectedItems.Count > 0 Then
NomClasseurXL = oDialog.SelectedItems(1)
'MsgBox "Le classeur Excel sélectionné est : " &
NomClasseurXL 'Empêche la fermeture de la fenêtre Excel
End If
MsgBox "Opération annulée", vbExclamation, "Pas d'importation
à partir d'Excel"
XLApp.Quit 'on quitte l'application
XL
Set XLApp = Nothing 'on vide la variable
objet XL
Exit Sub
End If
Set oDialog = Nothing
If NomClasseurXL = "" Then 'Si l'opérateur n'a rien
sélectionné
XLApp.Quit 'on quitte l'application XL
Set XLApp = Nothing 'on vide la variable objet XL
Exit Sub 'on quitte la procédure
End If
XLApp.WorkBooks.Open NomClasseurXL
XLApp.Visible = False
With XLApp
'.Workbooks.Open FileName:=NomClasseurXL 'Ouvre le Classeur
voulu
'MsgBox "Erreur N° : " & Err.Number & " " & Err.Description
'Erreurs récupérables
If Err.Number = 1004 Then 'Fichier n'existe
pas
MsgBox "Erreur sur le nom du classeur Excel ou sur le chemin
d'accès"
Exit Sub
End If
'.WindowState = xlMinimized 'Réduit la fenêtre
XL (mais la réaffiche)
.Visible = False 'True 'Fenêtre
invisible/visible
If ActiveProject.CurrentGroup <> "Aucun groupe" Then
Clic = MsgBox("Vous ne pouvez pas insérer de tâche dans un
regroupement." & Chr(10) & "voulez-vous continuer ?", vbYesNo,
"Import des données Excel")
If Clic = vbNo Then Exit Sub
End If
GroupApply Name:="Aucun groupe"
SelectTaskField Row:=1, Column:="Nom", RowRelative:úlse
EditInsert
NomTache = .Range("DTimpr!MSPTache").Rows(1).Value 'Lit
le champ "DTimpr!MSPTache" dans Excel
SetTaskField Field:="Nom", Value:=NomTache, TaskID:=1 'Dépose le
nom de la tâche qui figure dans le champ "DTimpr!MSPTache"
SetTaskField Field:="Number3",
Value:=.Range("DTimpr!MSPNBoeuvre"), TaskID:=1 'Dépose le Nombre
d'oeuvres
SetTaskField Field:="Text2",
Value:=.Range("DTimpr!MSPdemandeur"), TaskID:=1 'Dépose le nom du
demandeur : liste à mettre à jour!
'SetTaskField Field:="Salles Départ",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
SetTaskField Field:="EnterpriseOutlineCode1",
Value:=.Range("DTimpr!MSPsalle1"), TaskID:=1
'EnterpriseTaskOutlineCode1
End With
'Application.ScreenUpdating = True
MsgBox "Importation des données Excel terminée", vbInformation,
"Génération demande via Excel"
XLApp.ActiveWorkbook.Close SaveChanges:úlse 'Ferme le Classeur
sans sauvegarde !
XLApp.Quit
Set XLApp = Nothing
End Sub