Controle fichier excel ouvert
Résolu
marcod59
Messages postés
170
Date d'inscription
vendredi 16 janvier 2004
Statut
Membre
Dernière intervention
13 juin 2010
-
6 avril 2007 à 17:53
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 - 7 avril 2007 à 20:51
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 - 7 avril 2007 à 20:51
A voir également:
- Controle fichier excel ouvert
- Fichier json - Conseils pratiques -Javascript
- Arctan excel - Forum VBA Office (Excel, Word ...)
- Les fonctions " racines niemmes " et " arctan "et "arccos " et "arcsin" - Forum Visual Basic
- Tangente et arctangente ✓ - Forum C++ & C++ .NET
- Fichier excel gestion de stock - Forum Visual Basic 6
6 réponses
cs_MPi
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
17 août 2018
23
7 avril 2007 à 15:03
7 avril 2007 à 15:03
Je viens de faire le test sous VB6 et ce code affiche bien tous les classeurs déjà ouverts
Dim Fenetre As Window
For Each Fenetre In Windows
MsgBox Fenetre.Caption
Next
Ça n'affichera pas le chemin complet, par contre.
MPi
Dim Fenetre As Window
For Each Fenetre In Windows
MsgBox Fenetre.Caption
Next
Ça n'affichera pas le chemin complet, par contre.
MPi
mortalino
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
6 avril 2007 à 20:51
6 avril 2007 à 20:51
Salut,
utilise mon snippet, il est fait pour :
Private Const OF_SHARE_EXCLUSIVE = &H10
Private Declare Function lopen Lib "kernel32" Alias "_lopen" (ByVal lpPathName As String, ByVal iReadWrite As Long) As Long
Private Declare Function lclose Lib "kernel32" Alias "_lclose" (ByVal hFile As Long) As Long
Function OpenDocXlsFile(FileToOpen As String) As Long
' retourne :
' -1 -> erreur
' 0 -> fichier déjà ouvert, ouverture en lecture seule
' 1 -> ouverture première instance
OpenDocXlsFile = -1
Dim sExt As String
Dim NomAppli As String
' type de fichier par son extension
If LenB(FileToOpen) < 16 Then
Exit Function
Else
sExt = LCase$(RightB$(FileToOpen, 8))
If sExt = ".doc" Or sExt = ".rtf" Then
NomAppli = "Word"
ElseIf sExt = ".xls" Or sExt = ".csv" Then
NomAppli = "Excel"
Else
Exit Function
End If
End If
' ouverture office
Dim MonApp As Object
Dim MonDoc As Object
Dim hFile As Long
hFile = lopen(FileToOpen, OF_SHARE_EXCLUSIVE)
If hFile <> -1 Then 'pas ouvert
lclose (hFile)
Set MonApp = CreateObject(NomAppli & ".Application")
If NomAppli = "Word" Then
Set MonDoc = MonApp.Documents.Open(FileToOpen)
Else
Set MonDoc = MonApp.Workbooks.Open(FileToOpen)
End If
OpenDocXlsFile = 1
ElseIf (hFile = -1) And (Err.LastDllError = 32) Then 'déjà ouvert
lclose (hFile)
Set MonApp = CreateObject(NomAppli & ".Application")
If NomAppli = "Word" Then
On Local Error Resume Next
Set MonDoc = MonApp.Documents.Open(FileToOpen, , True)
If Err.Number = 4198 Then
' word 2000, utilisateur fait ANNULER
Err.Clear
GoTo Lbl_Exit
End If
On Error GoTo 0
Else
Set MonDoc = MonApp.Workbooks.Open(FileToOpen, , True)
End If
OpenDocXlsFile = 0
End If
MonApp.Visible = True
Lbl_Exit:
Set MonDoc = Nothing
Set MonApp = Nothing
End Function
' EXEMPLE
Private Sub Form_Load()
Debug.Print "Word : " & OpenDocXlsFile("C:\Nouveau Document Microsoft Word.doc")
Debug.Print "Excel : " & OpenDocXlsFile("C:\test.xls")
Unload Me
End Sub
~ <small> Mortalino ~ Colorisation automatique </small>
@++
<hr width ="100%" size="2" />
--Mortalino--
Le mystérieux chevalier, "Provençal, le Gaulois"
/DIV>
utilise mon snippet, il est fait pour :
Private Const OF_SHARE_EXCLUSIVE = &H10
Private Declare Function lopen Lib "kernel32" Alias "_lopen" (ByVal lpPathName As String, ByVal iReadWrite As Long) As Long
Private Declare Function lclose Lib "kernel32" Alias "_lclose" (ByVal hFile As Long) As Long
Function OpenDocXlsFile(FileToOpen As String) As Long
' retourne :
' -1 -> erreur
' 0 -> fichier déjà ouvert, ouverture en lecture seule
' 1 -> ouverture première instance
OpenDocXlsFile = -1
Dim sExt As String
Dim NomAppli As String
' type de fichier par son extension
If LenB(FileToOpen) < 16 Then
Exit Function
Else
sExt = LCase$(RightB$(FileToOpen, 8))
If sExt = ".doc" Or sExt = ".rtf" Then
NomAppli = "Word"
ElseIf sExt = ".xls" Or sExt = ".csv" Then
NomAppli = "Excel"
Else
Exit Function
End If
End If
' ouverture office
Dim MonApp As Object
Dim MonDoc As Object
Dim hFile As Long
hFile = lopen(FileToOpen, OF_SHARE_EXCLUSIVE)
If hFile <> -1 Then 'pas ouvert
lclose (hFile)
Set MonApp = CreateObject(NomAppli & ".Application")
If NomAppli = "Word" Then
Set MonDoc = MonApp.Documents.Open(FileToOpen)
Else
Set MonDoc = MonApp.Workbooks.Open(FileToOpen)
End If
OpenDocXlsFile = 1
ElseIf (hFile = -1) And (Err.LastDllError = 32) Then 'déjà ouvert
lclose (hFile)
Set MonApp = CreateObject(NomAppli & ".Application")
If NomAppli = "Word" Then
On Local Error Resume Next
Set MonDoc = MonApp.Documents.Open(FileToOpen, , True)
If Err.Number = 4198 Then
' word 2000, utilisateur fait ANNULER
Err.Clear
GoTo Lbl_Exit
End If
On Error GoTo 0
Else
Set MonDoc = MonApp.Workbooks.Open(FileToOpen, , True)
End If
OpenDocXlsFile = 0
End If
MonApp.Visible = True
Lbl_Exit:
Set MonDoc = Nothing
Set MonApp = Nothing
End Function
' EXEMPLE
Private Sub Form_Load()
Debug.Print "Word : " & OpenDocXlsFile("C:\Nouveau Document Microsoft Word.doc")
Debug.Print "Excel : " & OpenDocXlsFile("C:\test.xls")
Unload Me
End Sub
~ <small> Mortalino ~ Colorisation automatique </small>
@++
<hr width ="100%" size="2" />
--Mortalino--
Le mystérieux chevalier, "Provençal, le Gaulois"
/DIV>
cs_MPi
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
17 août 2018
23
6 avril 2007 à 23:36
6 avril 2007 à 23:36
Tu travailles à partir d'Excel (VBA) ou de VB ou autre ?
Si tu travailles sous Excel, il y a la "collection" Windows qui te donne le nom de tous les fichiers qui sont ouverts dans la session. Équivalent à aller dans le menu Fenêtre et regarder ce qui s'y trouve.
MPi
Si tu travailles sous Excel, il y a la "collection" Windows qui te donne le nom de tous les fichiers qui sont ouverts dans la session. Équivalent à aller dans le menu Fenêtre et regarder ce qui s'y trouve.
MPi
marcod59
Messages postés
170
Date d'inscription
vendredi 16 janvier 2004
Statut
Membre
Dernière intervention
13 juin 2010
7 avril 2007 à 09:31
7 avril 2007 à 09:31
Salut Mortalino et MPI,
Premièrement, merci d'avoir répondu, ensuite.
Pour répondre à MPI, je travail en VB.
Pour Mortalino, j'ai un petit souci avec ton code. Tout d'abord, je l'ai mis dans un module, ensuite je l'ai inclus dans mon code de cette façon :
Private Sub Cmdexcel_Click()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim XlSheet As Excel.Worksheet
Dim b, l As Integer
Set xlApp = New Excel.Application
Set xlBook = xlApp.Workbooks.Add
Set XlSheet = xlBook.Worksheets(1)
'' désactive les messages d'Excel
xlApp.Application.DisplayAlerts = False
If OpenDocXlsFile(App.Path & "\relevé.xls") = 0 Then
msg = MsgBox("Veuillez fermer le fichier relevé.xls" & Chr(10) & "pour pouvoir récupérer les données", vbCritical)
GoTo fin
End If
' Ouvre le fichier
xlApp.Workbooks.Open FileName:=App.Path & "\relevé.xls", Editable:=True, ReadOnly:=False
b = Lstview1.ListItems.Count
For a = 1 To b
l = xlApp.Sheets("donnees").Range("A65536").End(xlUp).row + 1
Set ObjListe = Nothing
Set ObjListe = Lstview1.ListItems(a)
xlApp.Sheets("donnees").Range("A" & l).Value = Lstview1.ListItems.Item(1)
xlApp.Sheets("donnees").Range("B" & l).Value = ObjListe.SubItems(1)
xlApp.Sheets("donnees").Range("C" & l).Value = ObjListe.SubItems(2)
xlApp.Sheets("donnees").Range("D" & l).Value = ObjListe.SubItems(3)
xlApp.Sheets("donnees").Range("E" & l).Value = ObjListe.SubItems(4)
xlApp.Sheets("donnees").Range("F" & l).Value = ObjListe.SubItems(5)
xlApp.Sheets("donnees").Range("G" & l).Value = ObjListe.SubItems(6)
xlApp.Sheets("donnees").Range("H" & l).Value = ObjListe.SubItems(7)
xlApp.Sheets("donnees").Range("I" & l).Value = ObjListe.SubItems(8)
xlApp.Sheets("donnees").Range("J" & l).Value = ObjListe.SubItems(9)
xlApp.Sheets("donnees").Range("K" & l).Value = ObjListe.SubItems(10)
xlApp.Sheets("donnees").Range("L" & l).Value = ObjListe.SubItems(11)
xlApp.Sheets("donnees").Range("M" & l).Value = ObjListe.SubItems(12)
Next a
fin:
xlApp.ActiveWorkbook.Save
xlApp.Application.DisplayAlerts = True
xlBook.Close
xlApp.Quit
Set xlApp = Nothing
Set xlBook = Nothing
Set XlSheet = Nothing
End Sub
Le problème, et qu'il m'ouvre à chaque fois un fichier excel et que dans tous les cas, je n'arrive pas à enregistrer les données.
Je pense que je n'utilise pas ton code correctement. Peux-tu me mettre sur le bon rail. Merci
Joyeuses Pâques à vous
@+++
marcod59
Premièrement, merci d'avoir répondu, ensuite.
Pour répondre à MPI, je travail en VB.
Pour Mortalino, j'ai un petit souci avec ton code. Tout d'abord, je l'ai mis dans un module, ensuite je l'ai inclus dans mon code de cette façon :
Private Sub Cmdexcel_Click()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim XlSheet As Excel.Worksheet
Dim b, l As Integer
Set xlApp = New Excel.Application
Set xlBook = xlApp.Workbooks.Add
Set XlSheet = xlBook.Worksheets(1)
'' désactive les messages d'Excel
xlApp.Application.DisplayAlerts = False
If OpenDocXlsFile(App.Path & "\relevé.xls") = 0 Then
msg = MsgBox("Veuillez fermer le fichier relevé.xls" & Chr(10) & "pour pouvoir récupérer les données", vbCritical)
GoTo fin
End If
' Ouvre le fichier
xlApp.Workbooks.Open FileName:=App.Path & "\relevé.xls", Editable:=True, ReadOnly:=False
b = Lstview1.ListItems.Count
For a = 1 To b
l = xlApp.Sheets("donnees").Range("A65536").End(xlUp).row + 1
Set ObjListe = Nothing
Set ObjListe = Lstview1.ListItems(a)
xlApp.Sheets("donnees").Range("A" & l).Value = Lstview1.ListItems.Item(1)
xlApp.Sheets("donnees").Range("B" & l).Value = ObjListe.SubItems(1)
xlApp.Sheets("donnees").Range("C" & l).Value = ObjListe.SubItems(2)
xlApp.Sheets("donnees").Range("D" & l).Value = ObjListe.SubItems(3)
xlApp.Sheets("donnees").Range("E" & l).Value = ObjListe.SubItems(4)
xlApp.Sheets("donnees").Range("F" & l).Value = ObjListe.SubItems(5)
xlApp.Sheets("donnees").Range("G" & l).Value = ObjListe.SubItems(6)
xlApp.Sheets("donnees").Range("H" & l).Value = ObjListe.SubItems(7)
xlApp.Sheets("donnees").Range("I" & l).Value = ObjListe.SubItems(8)
xlApp.Sheets("donnees").Range("J" & l).Value = ObjListe.SubItems(9)
xlApp.Sheets("donnees").Range("K" & l).Value = ObjListe.SubItems(10)
xlApp.Sheets("donnees").Range("L" & l).Value = ObjListe.SubItems(11)
xlApp.Sheets("donnees").Range("M" & l).Value = ObjListe.SubItems(12)
Next a
fin:
xlApp.ActiveWorkbook.Save
xlApp.Application.DisplayAlerts = True
xlBook.Close
xlApp.Quit
Set xlApp = Nothing
Set xlBook = Nothing
Set XlSheet = Nothing
End Sub
Le problème, et qu'il m'ouvre à chaque fois un fichier excel et que dans tous les cas, je n'arrive pas à enregistrer les données.
Je pense que je n'utilise pas ton code correctement. Peux-tu me mettre sur le bon rail. Merci
Joyeuses Pâques à vous
@+++
marcod59
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
marcod59
Messages postés
170
Date d'inscription
vendredi 16 janvier 2004
Statut
Membre
Dernière intervention
13 juin 2010
7 avril 2007 à 16:40
7 avril 2007 à 16:40
Merci MPI, c'est justement ce que je cherchais. Juste le nom du fichier afin de faire le test car s'il est ouvert je ne peux rentrer les données. Donc en faisant un test avant, je le signale pour qu'il soit fermé.
Joyeuses Pâques
@+++
marcod59
Joyeuses Pâques
@+++
marcod59
cs_MPi
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
17 août 2018
23
7 avril 2007 à 20:51
7 avril 2007 à 20:51
Attention toutefois ...
Le fichier pourrait être ouvert dans une autre session d'Excel.
À ce moment-là, il ne serait pas dans la liste, je pense (?)
Tu pourrais toujours ajouter une gestion d'erreur.
MPi
Le fichier pourrait être ouvert dans une autre session d'Excel.
À ce moment-là, il ne serait pas dans la liste, je pense (?)
Tu pourrais toujours ajouter une gestion d'erreur.
MPi
