VBA - si fichier déja ouvert alors activé sinon

Le 06/04/2012 à 11:50

Bonjour tout le monde,

j'ai écris un bout de code pour que quand l'utilisateur clique sur un bouton dans le fichier 1 vba ouvre un fichier 2, copie une plage de cellule et la colle dans le fichier 1. Le problème se pose quand le fichier 2 est déja ouvert, je ne sais pas comment contourner l'erreur. Si quelqu'un pouvait m'aider, et j'en doute pas , se serait sympa !!!

Sub importer()

Application.ScreenUpdating = False

If MsgBox("Voulez-vous importer les données?", vbYesNo, "Importation") = vbYes Then

'UserForm1.Show

'j'enregistre le nom de ce fichier dans la feuille parametre en cellule D1
Dim nom
nom = ActiveWorkbook.Name
Sheets("Parametres").Range("D1") = nom

'Je supprime le .xls
Sheets("Parametres").Select
Range("D1").Select
ActiveCell.Replace What:=".xls", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

'Je supprime les données dans la feuille gla du fichier reporting analytique
Sheets("Gla").Select
Columns("A:AY").ClearContents

'\\\\\\\\\\\\\\\\\\\\\tester si fichier deja ouvert\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

'j'ouvre le fichier 2
Application.Workbooks.Open "\\Jupiter\Cgestion\Sabine\Requete\Gla+2012.xlsb"

'je filtre les données du fichier gla+2012
'Windows("Gla+2012.xlsb").Activate
Sheets("GLA").Select
ActiveSheet.ListObjects("BDD").Range.AutoFilter Field:=5, Criteria1:="CAT"
ActiveSheet.ListObjects("BDD").Range.AutoFilter Field:=7, Criteria1:= _
    "=990 - CHIFFRE D'AFFAIRES GESTION", Operator:=xlOr, Criteria2:= _
    "=993 - PRODUCTION SPECIFIQUE"

'Selection de la plage de cellule
Dim fin

Sheets("GLA").Select
Range("A3").Select

Do While ActiveCell <> ""
ActiveCell.Offset(1, 0).Select

Loop

ActiveCell.Offset(-1, 50).Select

fin = ActiveCell.Address

Range("A3:" & fin).Select

'je copy les données visibles du fichier gla+2012
Selection.SpecialCells(xlCellTypeVisible).Copy

'je réactive le fichier reporting analytique
Workbooks(nom).Activate

'je me place en feuil gla cellule a1 et je colle tout
Sheets("Gla").Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False

'je recalcule le fichier
ActiveWorkbook.Calculate

'je selectionne le fichier gla+2012
Workbooks("Gla+2012").Activate
'Annule toutes les alertes Excel
Application.DisplayAlerts = False

'Ferme le classeur
ActiveWorkbook.Close

'Restaure l'affichage des Alertes
Application.DisplayAlerts = True

Else
Exit Sub
End If

Application.ScreenUpdating = True

End Sub
Le 06/04/2012 à 12:41

Salut Korosifs

Essaye avec ceci

'\\\\\\\\\\\\\\\\\\\\\tester si fichier deja ouvert\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
On Error Resume Next
Workbooks("Gla+2012.xlsb").Activate
' Si une erreur est renvoyée, fichier non ouvert
If Err.Number <> 0 Then
  'j'ouvre le fichier 2
  Application.Workbooks.Open "\\Jupiter\Cgestion\Sabine\Requete\Gla+2012.xlsb"
End If
On Error GoTo 0

A+

Le 06/04/2012 à 12:47

Super, ça marche nickel!!! merci beaucoup BrunoM45

Le 06/04/2012 à 12:48

De rien

Le 29/01/2017 à 17:27

bonjour tout le monde ,

je suis debutant en VBA et je viens de faire un ptit programme pour faire appel à un fichier word à travers de mon bouton sur userfom afin de transferet des donnees vers des signets word, ca marche tres bien mais juste un probleme c est que lorsque le fichier est deja ouvert dés lors tout mon programme s arrete, je vous envoi mon code et merci d avance pour votre aide

 Private Sub CommandButton3_Click()

Dim WRDAPP As Object
Dim WRDDOC As Object
Set WRDAPP = CreateObject("WORD.APPLICATION")
Set WRDDOC = WRDAPP.Documents.Open("C:\Users\Desktop\GADIRI\YOUNESS\GADIRI PUB2.docm")

WRDAPP.ShowMe
WRDAPP.Visible = True

 With WRDDOC

    .Bookmarks("NOM").Range.Text = Me.TextBox1.Value

    .Bookmarks("CNIE").Range.Text = Me.TextBox2.Value

    .Bookmarks("MATRICULE").Range.Text = Me.TextBox3.Value  

 WRDDOC.PrintOut
  WRDDOC.Close SaveChanges:=False
  WRDAPP.Quit
 End With
 End Sub

desole j ai oublié de terminer ma question, en fait j ai vu vos codes pour verfier si le fichier word est deja ouvert mais sans succés j arrive pas.

Le 31/01/2017 à 02:49

Bonjour Gad1984

Dans ton cas, tu peux utiliser ce genre de fonction 

Function FichierOuvert(ByRef CheminFichier As String) As Boolean
  Dim NumFic As Long
  On Error GoTo Erreur
  NumFic = FreeFile
  Open CheminFichier For Input Lock Read As #NumFic
  Close #NumFic
  FichierOuvert = False
  On Error GoTo 0
  Exit Function

Erreur:
  FichierOuvert = True
  On Error GoTo 0
End Function

A+

Le 31/01/2017 à 19:36

Merci Bruno pour le temps que tu m as consacre, mais malheureusement ca marche pas j ai un message d erreur sur la premiere ligne qui m ecrit : Erreur de compilation: attendu identificateur.

Mon code est le suivant:[code]function fichierouvert (byref("c:\USer\youn\gadiripub2.docm") as string) as boolean

Dim NumFic As Long

On Error GoTo Erreur

NumFic = FreeFile

Open CheminFichier For Input Lock Read As #NumFic

Close #NumFic

FichierOuvert = False

On Error GoTo 0

Exit Function

Erreur:

FichierOuvert = True

On Error GoTo 0

End Function

/code]

Le 31/01/2017 à 20:12

Bonsoir,

Ou là

Pour appeler une fonction il faut faire : NomFonction(Paramètre)

Dans le cas de cette fonction et selon le code initial, il faut faire :

Private Sub CommandButton3_Click()
  Dim LeFichier as String
  Dim WRDAPP As Object
  Dim WRDDOC As Object
  ' Initialisation de variable
  LeFichier = "C:\Users\Desktop\GADIRI\YOUNESS\GADIRI PUB2.docm"
  ' Tester si le fichier est déjà ouvert on sort
  If FichierOuvert(LeFichier) then Exit Sub
  ' Sinon on continue
  Set WRDAPP = CreateObject("WORD.APPLICATION")
  Set WRDDOC = WRDAPP.Documents.Open(LeFichier)

  WRDAPP.ShowMe
  WRDAPP.Visible = True
  With WRDDOC  
    .Bookmarks("NOM").Range.Text = Me.TextBox1.Value
    .Bookmarks("CNIE").Range.Text = Me.TextBox2.Value
    .Bookmarks("MATRICULE").Range.Text = Me.TextBox3.Value  
    .PrintOut
    .Close SaveChanges:=False
  End With
  WRDAPP.Quit
 End Sub

Function FichierOuvert(ByRef CheminFichier As String) As Boolean
  Dim NumFic As Long
  On Error GoTo Erreur
  NumFic = FreeFile
  Open CheminFichier For Input Lock Read As #NumFic
  Close #NumFic
  FichierOuvert = False
  On Error GoTo 0
  Exit Function

Erreur:
  FichierOuvert = True
  On Error GoTo 0
End Function

Voilà

Le 31/01/2017 à 20:22

Merci Bruno ca marche tres bien, encore merci ennormement .

Rechercher des sujets similaires à "vba fichier deja ouvert active sinon"