ouvrire un fichier avec un VBA

Dim sFile As String

sFile = Application.GetOpenFilename("Microsoft Excel Files (*.xls),
*.xls")
If sFile <> "False" Then

Workbooks.Open sFile
Application.Run "'" & ActiveWorkbook.Name & "'!Macro_pri"
ActiveWorkbook.Close savechanges:úlse

Workbooks.Open Left(sFile, Len(sFile) - 4) & ".nurg"
Application.Run "'" & ActiveWorkbook.Name & "'!Macro_nurg"
ActiveWorkbook.Close savechanges:úlse

End If



--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"pellet15" <pellet15@videotron.ca> wrote in message
news:1151337246.798031.271810@b68g2000cwa.googlegroups.com...
Bonjour à tous

Avec un VBA je voudrait ouvrire un fichier après l'avoir choisie .
et exécuter la macros " Macro_pri ".
puis ouvrire le fichier du même nom mais avec l'extention .nurg
pour ensuite exécuter la "Macro_nurg".


Merci

Bnsoir Bob Phillips

Dans la macro suivante ,comment modifier pour qu'après avoir choisie
le premier nom de fichier ,il reste le même (pour les deux autres)
et ne me demande pas le nom du fichier mais change seulement
l'extention du premier pour les autres. '___?????

Merci

Sub Rasembler()
Filt = "Fichier Mic (*.pri),*.pri," '___ recherche le nom du premier
fichier __ok__
Title = "Selectionnez un Fichier (Explan) a Importer : "
Filename = Application.GetOpenFilename(FileFilter:=Filt, Title:=Title)
If Filename = False Then
MsgBox "aucun fichier choisi"
Exit Sub
End If
FichOuv = Filename
Workbooks.OpenText Filename:=FichOuv, Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=Tru e,
_
Comma:=False, Space:=False, Other:=False
Application.Run "Model_camionTestl.xls!Convertir_1_fichier"
Application.DisplayAlerts = False
ActiveWorkbook.Close savechanges:=False
Windows("Model_camionTestl.xls").Activate
Range("A1").Select
ActiveSheet.Paste
Range("A12").Select
Range("T1:AC3").Cut
ActiveSheet.Paste
Selection.End(xlDown).Select
ActiveCell(3, 1).Select
Filt = "Fichier Mic (*.nurg),*.nurg," '___?????deusième____
Title = "Selectionnez un Fichier (Explan) a Importer : "
Filename = Application.GetOpenFilename(FileFilter:=Filt, Title:=Title)
If Filename = False Then
MsgBox "aucun fichier choisi"
Exit Sub
End If
FichOuv = Filename
Workbooks.OpenText Filename:=FichOuv, Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=Tru e,
_
Comma:=False, Space:=False, Other:=False
Application.CutCopyMode = False
Application.Run "Model_camionTestl.xls!Convertir_2_fichier"
ActiveWorkbook.Close savechanges:=False
Windows("Model_camionTestl.xls").Activate
ActiveSheet.Paste
ActiveCell(1, 1).Select
Selection.End(xlDown).Select
Range("A12:j14").Copy
ActiveSheet.Paste
Selection.End(xlDown).Select
ActiveCell(3, 1).Select
Filt = "Fichier Mic (*.urg),*.urg," '___?????troisième_____
Title = "Selectionnez un Fichier (Explan) a Importer : "
Filename = Application.GetOpenFilename(FileFilter:=Filt, Title:=Title)
If Filename = False Then
MsgBox "aucun fichier choisi"
Exit Sub
End If
FichOuv = Filename
Workbooks.OpenText Filename:=FichOuv, Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=Tru e,
_
Comma:=False, Space:=False, Other:=False
Application.CutCopyMode = False
Application.Run "Model_camionTestl.xls!Convertir_2_fichier"
ActiveWorkbook.Close savechanges:=False
Windows("Model_camionTestl.xls").Activate
ActiveSheet.Paste
ActiveCell(1, 1).Select
Selection.End(xlDown).Select
Range("A12:j14").Copy
ActiveSheet.Paste
Selection.End(xlDown).Select
Range("C10").Select
Application.Run "Model_camionTestl.xls!sauve_et_onglet"
End Sub

Bonjour,

Tu peux t'inspirer de :
'nom du premier fichier
prem = "C:test324.pri"

'détermination du 2e à partir du 1er
oldext = ".pri" : newext = ".nurg"
deux = Left(prem, Len(prem) - Len(oldext)) & newext

'détermination du 3e à partir du 1er
oldext = ".pri" : newext = ".urg"
trois = Left(prem, Len(prem) - Len(oldext)) & newext

Je préfère passer par left(...) plutôt que par
application.substitute(...) car je ne suis pas sûr que ton fichier
original ne contienne pas .pri dans le chemin+nom complet

@+
FxM

Bnsoir Bob Phillips

Dans la macro suivante ,comment modifier pour qu'après avoir choisie
le premier nom de fichier ,il reste le même (pour les deux autres)
et ne me demande pas le nom du fichier mais change seulement
l'extention du premier pour les autres. '___?????

Merci

Sub Rasembler()
Filt = "Fichier Mic (*.pri),*.pri," '___ recherche le nom du premier
fichier __ok__
Title = "Selectionnez un Fichier (Explan) a Importer : "
Filename = Application.GetOpenFilename(FileFilter:=Filt, Title:=Title)
If Filename = False Then
MsgBox "aucun fichier choisi"
Exit Sub
End If
FichOuv = Filename
Workbooks.OpenText Filename:=FichOuv, Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:úlse, Tab:=True, Semicolon:=True,
_
Comma:úlse, Space:úlse, Other:úlse
Application.Run "Model_camionTestl.xls!Convertir_1_fichier"
Application.DisplayAlerts = False
ActiveWorkbook.Close savechanges:úlse
Windows("Model_camionTestl.xls").Activate
Range("A1").Select
ActiveSheet.Paste
Range("A12").Select
Range("T1:AC3").Cut
ActiveSheet.Paste
Selection.End(xlDown).Select
ActiveCell(3, 1).Select
Filt = "Fichier Mic (*.nurg),*.nurg," '___?????deusième____
Title = "Selectionnez un Fichier (Explan) a Importer : "
Filename = Application.GetOpenFilename(FileFilter:=Filt, Title:=Title)
If Filename = False Then
MsgBox "aucun fichier choisi"
Exit Sub
End If
FichOuv = Filename
Workbooks.OpenText Filename:=FichOuv, Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:úlse, Tab:=True, Semicolon:=True,
_
Comma:úlse, Space:úlse, Other:úlse
Application.CutCopyMode = False
Application.Run "Model_camionTestl.xls!Convertir_2_fichier"
ActiveWorkbook.Close savechanges:úlse
Windows("Model_camionTestl.xls").Activate
ActiveSheet.Paste
ActiveCell(1, 1).Select
Selection.End(xlDown).Select
Range("A12:j14").Copy
ActiveSheet.Paste
Selection.End(xlDown).Select
ActiveCell(3, 1).Select
Filt = "Fichier Mic (*.urg),*.urg," '___?????troisième_____
Title = "Selectionnez un Fichier (Explan) a Importer : "
Filename = Application.GetOpenFilename(FileFilter:=Filt, Title:=Title)
If Filename = False Then
MsgBox "aucun fichier choisi"
Exit Sub
End If
FichOuv = Filename
Workbooks.OpenText Filename:=FichOuv, Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:úlse, Tab:=True, Semicolon:=True,
_
Comma:úlse, Space:úlse, Other:úlse
Application.CutCopyMode = False
Application.Run "Model_camionTestl.xls!Convertir_2_fichier"
ActiveWorkbook.Close savechanges:úlse
Windows("Model_camionTestl.xls").Activate
ActiveSheet.Paste
ActiveCell(1, 1).Select
Selection.End(xlDown).Select
Range("A12:j14").Copy
ActiveSheet.Paste
Selection.End(xlDown).Select
Range("C10").Select
Application.Run "Model_camionTestl.xls!sauve_et_onglet"
End Sub

Non examiné, mais quelque chose comme

Sub Rasembler()
'___ recherche le nom du premier fichier __ok__
Filt = "Fichier Mic (*.pri),*.pri,"
Title = "Selectionnez un Fichier (Explan) a Importer : "
Filename = Application.GetOpenFilename(FileFilter:=Filt, Title:=Title)
If Filename = False Then
MsgBox "aucun fichier choisi"
Exit Sub
End If
FichOuv = Filename
Workbooks.OpenText Filename:=FichOuv, _
Origin:=xlWindows, _
StartRow:=1, _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:úlse, _
Tab:=True

Application.Run "Model_camionTestl.xls!Convertir_1_fichier"
ActiveWorkbook.Close savechanges:úlse
Windows("Model_camionTestl.xls").Activate
Range("A1").Select
ActiveSheet.Paste
Range("A12").Select
Range("T1:AC3").Cut
ActiveSheet.Paste
Selection.End(xlDown).Select
ActiveCell(3, 1).Select

'___?????deusième____
ipos = InStrRev(Filename, ".")
Filename = Left(Filename, ipos) & "nurg"
Workbooks.OpenText Filename:=Filename, _
Origin:=xlWindows, _
StartRow:=1, _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:úlse, _
Tab:=True, _
Semicolon:=True

Application.Run "Model_camionTestl.xls!Convertir_2_fichier"
ActiveWorkbook.Close savechanges:úlse
Windows("Model_camionTestl.xls").Activate
ActiveSheet.Paste
ActiveCell(1, 1).Select
Selection.End(xlDown).Select
Range("A12:j14").Copy
ActiveSheet.Paste
Selection.End(xlDown).Select
ActiveCell(3, 1).Select

'___?????troisième_____
Filename = Left(Filename, ipos) & "urg"
Workbooks.OpenText Filename:=Filename, _
Origin:=xlWindows, _
StartRow:=1, _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:úlse, _
Tab:=True

Windows("Model_camionTestl.xls").Activate
ActiveSheet.Paste
ActiveCell(1, 1).End(xlDown).Select
Range("A12:j14").Copy
ActiveSheet.Paste
Range("C10").Select
Application.Run "Model_camionTestl.xls!sauve_et_onglet"
End Sub

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

"pellet15" <pellet15@videotron.ca> wrote in message
news:1151377983.620309.141740@y41g2000cwy.googlegroups.com...

Bnsoir Bob Phillips

Dans la macro suivante ,comment modifier pour qu'après avoir choisie
le premier nom de fichier ,il reste le même (pour les deux autres)
et ne me demande pas le nom du fichier mais change seulement
l'extention du premier pour les autres. '___?????

Merci

Sub Rasembler()
Filt = "Fichier Mic (*.pri),*.pri," '___ recherche le nom du premier
fichier __ok__
Title = "Selectionnez un Fichier (Explan) a Importer : "
Filename = Application.GetOpenFilename(FileFilter:=Filt, Title:=Title)
If Filename = False Then
MsgBox "aucun fichier choisi"
Exit Sub
End If
FichOuv = Filename
Workbooks.OpenText Filename:=FichOuv, Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:úlse, Tab:=True, Semicolon:=True,
_
Comma:úlse, Space:úlse, Other:úlse
Application.Run "Model_camionTestl.xls!Convertir_1_fichier"
Application.DisplayAlerts = False
ActiveWorkbook.Close savechanges:úlse
Windows("Model_camionTestl.xls").Activate
Range("A1").Select
ActiveSheet.Paste
Range("A12").Select
Range("T1:AC3").Cut
ActiveSheet.Paste
Selection.End(xlDown).Select
ActiveCell(3, 1).Select
Filt = "Fichier Mic (*.nurg),*.nurg," '___?????deusième____
Title = "Selectionnez un Fichier (Explan) a Importer : "
Filename = Application.GetOpenFilename(FileFilter:=Filt, Title:=Title)
If Filename = False Then
MsgBox "aucun fichier choisi"
Exit Sub
End If
FichOuv = Filename
Workbooks.OpenText Filename:=FichOuv, Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:úlse, Tab:=True, Semicolon:=True,
_
Comma:úlse, Space:úlse, Other:úlse
Application.CutCopyMode = False
Application.Run "Model_camionTestl.xls!Convertir_2_fichier"
ActiveWorkbook.Close savechanges:úlse
Windows("Model_camionTestl.xls").Activate
ActiveSheet.Paste
ActiveCell(1, 1).Select
Selection.End(xlDown).Select
Range("A12:j14").Copy
ActiveSheet.Paste
Selection.End(xlDown).Select
ActiveCell(3, 1).Select
Filt = "Fichier Mic (*.urg),*.urg," '___?????troisième_____
Title = "Selectionnez un Fichier (Explan) a Importer : "
Filename = Application.GetOpenFilename(FileFilter:=Filt, Title:=Title)
If Filename = False Then
MsgBox "aucun fichier choisi"
Exit Sub
End If
FichOuv = Filename
Workbooks.OpenText Filename:=FichOuv, Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:úlse, Tab:=True, Semicolon:=True,
_
Comma:úlse, Space:úlse, Other:úlse
Application.CutCopyMode = False
Application.Run "Model_camionTestl.xls!Convertir_2_fichier"
ActiveWorkbook.Close savechanges:úlse
Windows("Model_camionTestl.xls").Activate
ActiveSheet.Paste
ActiveCell(1, 1).Select
Selection.End(xlDown).Select
Range("A12:j14").Copy
ActiveSheet.Paste
Selection.End(xlDown).Select
Range("C10").Select
Application.Run "Model_camionTestl.xls!sauve_et_onglet"
End Sub

Salutations

Bob

Bonjour Bob

Très bien cela fonctionne :-)

Mais j'ai un problème que je voudrait automatiser aussi.

Le problème est que parfois il y a plusieur série de fichier.
(Dans une série il y a toujours les 3 fichier avec le même nom
mais qui se termine par extention .pri , .nurg , .urg )

Dans la macros suivante je voudrait qu'elle exécute en premier tous
les fichiers
qui ont le même nom avec extention ".Pri" ,la différence entre ces
fichier est que le premier de la série porte le nom xxxx.pri si il y
en n'a d'autre
il portera le nom xxxx_1.pri, xxxx_2.pri, ou xxxx_3.pri..... jusqua
xxxx_9.pri.
et cela ce répète pour la deusième série d'extention.
xxxx,nurg ,xxxx_1.nurg ,xxxx_2.nurg, ou xxxx_3.nurg....jusqua
xxxx_9.nurg

et cela ce répète pour la dernière série extention.
xxxx,urg ,xxxx_1.urg ,xxxx_2.urg, ou xxxx_3.....jusqua xxxx_9.urg.

Cela est t'il possible !!

Merci pour votre aide

Sub Rasembler()
Filt = "Fichier Mic (*.pri),*.pri,"
Title = "Selectionnez un Fichier (Explan) a Importer : "
Filename = Application.GetOpenFilename(FileFilter:=Filt,
Title:=Title)
If Filename = False Then
MsgBox "aucun fichier choisi"
Exit Sub
End If
FichOuv = Filename
Workbooks.OpenText Filename:=FichOuv, _
Origin:=xlWindows, _
StartRow:=1, _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=True
Application.Run "Model_camionTestl.xls!Convertir_1_fichier"
ActiveWorkbook.Close savechanges:=False
Windows("Model_camionTestl.xls").Activate
Range("A1").Select
ActiveSheet.Paste
Range("A12").Select
Range("T1:AC3").Cut
ActiveSheet.Paste
Range("A1").Select
ipos = InStrRev(Filename, ".")
Filename = Left(Filename, ipos) & "nurg"
Workbooks.OpenText Filename:=Filename, _
Origin:=xlWindows, _
StartRow:=1, _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=True, _
Semicolon:=True
Application.Run "Model_camionTestl.xls!Convertir_1_fichier"
ActiveWorkbook.Close savechanges:=False
Windows("Model_camionTestl.xls").Activate
Sheets.Add
ActiveSheet.Name = "Near Urgent Defect"
ActiveSheet.Paste
Range("A12").Select
Sheets("Priority Defect").Select
Range("A12:J14").Select
Selection.Copy
Sheets("Near Urgent Defect").Select
ActiveSheet.Paste
Range("A15").Select
Filename = Left(Filename, ipos) & "urg"
Workbooks.OpenText Filename:=Filename, _
Origin:=xlWindows, _
StartRow:=1, _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=True, _
Semicolon:=True
Application.Run "Model_camionTestl.xls!Convertir_1_fichier"
ActiveWorkbook.Close savechanges:=False
Windows("Model_camionTestl.xls").Activate
Sheets.Add
ActiveSheet.Name = "Urgent Defect"
ActiveSheet.Paste
Range("A12").Select
Sheets("Priority Defect").Select
Range("A12:J14").Select
Selection.Copy
Sheets("Urgent Defect").Select
ActiveSheet.Paste
Range("A15").Select
Application.Run "Model_camionTestl.xls!sauve_et_onglet"
End Sub

Bonsoir Bob

Ci cela ne est possible je te ferais parvenir
une copie de mes fichiers pour mieux comprendre
le problème.
Mon courriel est
pellet15 @ videotron.ca

merci