Titre du sujet : Re: Comment tester si un fichier excel est déjà ouvert dans une macro
par Basket le 16/02/2011 09:16:51
Sub Maj_donnees()
'
' Maj_donnees Macro
' Macro enregistrée le 28/12/2010 par Olivier
'
' Touche de raccourci du clavier: Ctrl+j
'
' Ouverture du fichier ci-dessous avec le no du fichier en paramètre récupéré
' en cellule G2
' fic = "\\naoned\sous-traitant\AdjustHR\03 - Fiche navette\FN 018\Suivi Fiche 018"
Dim fic1 As String
Dim fic2 As String
Dim fic3 As String
Dim fic4 As String
Dim fic5 As String
Dim fic As String
fic1 = "\\naoned\sous-traitant\AdjustHR\03 - Fiche navette\FN "
fic2 = "Suivi Fiche "
fic3 = "0"
fic33 = "00"
fic4 = "='[Suivi Fiche "
fic5 = ".xls]Besoin'!"
fic6 = ".xls"
DATED = "R1C5"
HEURED = "R1C6"
NOFICHE = "R1C3"
NOMD = "R3C3"
CVREC = "R4C9"
DATELIM = "R5C11"
HEURELIM = "R5C12"
CVDLIM = "R5C13"
TJMO = "R1C14"
TJMN = "R2C14"
ACCUS = "R4C5"
CV1 = "R7C1"
CV1H = "R7C2"
TYPEB = "R4C3"
NBCVR = "R1C9"
NBCVOK = "R2C9"
NBCV48 = "R3C9"
SLA = "R4C9"
CVRET = "R1C12"
ENT = "R3C12"
RETOUR = "R4C12"
' Détermination du nom du fichier à ouvrir
fic = fic1 & Range(CStr("G2")) & "" & fic2 & Range(CStr("G2"))
If Cells(2, 7).Value < 99 Then
fic = fic1 & fic3 & Range(CStr("G2")) & "" & fic2 & fic3 & Range(CStr("G2"))
End If
If Cells(2, 7).Value < 10 Then
fic = fic1 & fic33 & Range(CStr("G2")) & "" & fic2 & fic33 & Range(CStr("G2"))
End If
' Test fichier ouvert
If ClasseurEstOuvert(fic) Then
MsgBox "Le fichier " & fic & " est ouvert." & vbLf & vbLf & "Arrêt de la procédure" & vbLf & vbLf & "Fermer le fichier et relancer"
Else
' Ouverture du fichier
Workbooks.Open Filename:=fic
Windows("Suivi des besoins.xls").Activate
' Activation de la cellule pour mise à jour "Date de la demande"
Range("B" + CStr(Range("G1"))).Select
' Constitution de la formule "='[Suivi Fiche 018.xls]Besoin'!R1C6" avec le 018 en paramètre
formule = fic4 & Range(CStr("G2")) & fic5 & DATED
If Cells(2, 7).Value < 99 Then
formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & DATED
End If
If Cells(2, 7).Value < 10 Then
formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & DATED
End If
ActiveCell.FormulaR1C1 = formule
' Activation de la cellule pour mise à jour "Heure de la demande"
Range("C" + CStr(Range("G1"))).Select
formule = fic4 & Range(CStr("G2")) & fic5 & HEURED
If Cells(2, 7).Value < 99 Then
formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & HEURED
End If
If Cells(2, 7).Value < 10 Then
formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & HEURED
End If
ActiveCell.FormulaR1C1 = formule
' Activation de la cellule pour mise à jour "N° de Fiche"
Range("E" + CStr(Range("G1"))).Select
formule = fic4 & Range(CStr("G2")) & fic5 & NOFICHE
If Cells(2, 7).Value < 99 Then
formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & NOFICHE
End If
If Cells(2, 7).Value < 10 Then
formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & NOFICHE
End If
ActiveCell.FormulaR1C1 = formule
' Activation de la cellule pour mise à jour "Nom du demandeur"
Range("I" + CStr(Range("G1"))).Select
formule = fic4 & Range(CStr("G2")) & fic5 & NOMD
If Cells(2, 7).Value < 99 Then
formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & NOMD
End If
If Cells(2, 7).Value < 10 Then
formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & NOMD
End If
ActiveCell.FormulaR1C1 = formule
' Activation de la cellule pour mise à jour "CV Reçus sous 2 Jours"
Range("J" + CStr(Range("G1"))).Select
formule = fic4 & Range(CStr("G2")) & fic5 & CVREC
If Cells(2, 7).Value < 99 Then
formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & CVREC
End If
If Cells(2, 7).Value < 10 Then
formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & CVREC
End If
ActiveCell.FormulaR1C1 = formule
' Activation de la cellule pour mise à jour "Date limite de traitement par Adjust"
Range("K" + CStr(Range("G1"))).Select
formule = fic4 & Range(CStr("G2")) & fic5 & DATELIM
If Cells(2, 7).Value < 99 Then
formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & DATELIM
End If
If Cells(2, 7).Value < 10 Then
formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & DATELIM
End If
ActiveCell.FormulaR1C1 = formule
' Activation de la cellule pour mise à jour "Heure limite de traitement par Adjust"
Range("L" + CStr(Range("G1"))).Select
formule = fic4 & Range(CStr("G2")) & fic5 & HEURELIM
If Cells(2, 7).Value < 99 Then
formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & HEURELIM
End If
If Cells(2, 7).Value < 10 Then
formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & HEURELIM
End If
ActiveCell.FormulaR1C1 = formule
' Activation de la cellule pour mise à jour "NB CV OK 48"
Range("N" + CStr(Range("G1"))).Select
formule = fic4 & Range(CStr("G2")) & fic5 & NBCV48
If Cells(2, 7).Value < 99 Then
formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & NBCV48
End If
If Cells(2, 7).Value < 10 Then
formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & NBCV48
End If
ActiveCell.FormulaR1C1 = formule
' Activation de la cellule pour mise à jour "Accusé réception"
Range("O" + CStr(Range("G1"))).Select
formule = fic4 & Range(CStr("G2")) & fic5 & ACCUS
If Cells(2, 7).Value < 99 Then
formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & ACCUS
End If
If Cells(2, 7).Value < 10 Then
formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & ACCUS
End If
ActiveCell.FormulaR1C1 = formule
' Activation de la cellule pour mise à jour "NB CV Reçus sous date limite de traitement"
Range("P" + CStr(Range("G1"))).Select
formule = fic4 & Range(CStr("G2")) & fic5 & CVDLIM
If Cells(2, 7).Value < 99 Then
formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & CVDLIM
End If
If Cells(2, 7).Value < 10 Then
formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & CVDLIM
End If
ActiveCell.FormulaR1C1 = formule
' Activation de la cellule pour mise à jour "Heure Réception CV 1"
Range("Q" + CStr(Range("G1"))).Select
formule = fic4 & Range(CStr("G2")) & fic5 & CV1H
If Cells(2, 7).Value < 99 Then
formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & CV1H
End If
If Cells(2, 7).Value < 10 Then
formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & CV1H
End If
ActiveCell.FormulaR1C1 = formule
' Activation de la cellule pour mise à jour "Type de besoin"
Range("R" + CStr(Range("G1"))).Select
formule = fic4 & Range(CStr("G2")) & fic5 & TYPEB
If Cells(2, 7).Value < 99 Then
formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & TYPEB
End If
If Cells(2, 7).Value < 10 Then
formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & TYPEB
End If
ActiveCell.FormulaR1C1 = formule
' Activation de la cellule pour mise à jour "NB CV Reçu"
Range("S" + CStr(Range("G1"))).Select
formule = fic4 & Range(CStr("G2")) & fic5 & NBCVR
If Cells(2, 7).Value < 99 Then
formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & NBCVR
End If
If Cells(2, 7).Value < 10 Then
formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & NBCVR
End If
ActiveCell.FormulaR1C1 = formule
' Activation de la cellule pour mise à jour "NB CV OK"
Range("T" + CStr(Range("G1"))).Select
formule = fic4 & Range(CStr("G2")) & fic5 & NBCVOK
If Cells(2, 7).Value < 99 Then
formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & NBCVOK
End If
If Cells(2, 7).Value < 10 Then
formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & NBCVOK
End If
ActiveCell.FormulaR1C1 = formule
' Activation de la cellule pour mise à jour "NB CV RETENU"
Range("U" + CStr(Range("G1"))).Select
formule = fic4 & Range(CStr("G2")) & fic5 & CVRET
If Cells(2, 7).Value < 99 Then
formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & CVRET
End If
If Cells(2, 7).Value < 10 Then
formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & CVRET
End If
ActiveCell.FormulaR1C1 = formule
' Activation de la cellule pour mise à jour "NB Entretien"
Range("V" + CStr(Range("G1"))).Select
formule = fic4 & Range(CStr("G2")) & fic5 & ENT
If Cells(2, 7).Value < 99 Then
formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & ENT
End If
If Cells(2, 7).Value < 10 Then
formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & ENT
End If
ActiveCell.FormulaR1C1 = formule
' Activation de la cellule pour mise à jour "RETOUR"
Range("W" + CStr(Range("G1"))).Select
formule = fic4 & Range(CStr("G2")) & fic5 & RETOUR
If Cells(2, 7).Value < 99 Then
formule = fic4 & fic3 & Range(CStr("G2")) & fic5 & RETOUR
End If
If Cells(2, 7).Value < 10 Then
formule = fic4 & fic33 & Range(CStr("G2")) & fic5 & RETOUR
End If
ActiveCell.FormulaR1C1 = formule
' Positionnement dans la cellule à gauche
Range("A" + CStr(Range("G1"))).Select
' Fermeture du fichier
fic = fic2 & Range(CStr("G2")) & fic6
If Cells(2, 7).Value < 99 Then
fic = fic2 & fic3 & Range(CStr("G2")) & fic6
End If
If Cells(2, 7).Value < 10 Then
fic = fic2 & fic33 & Range(CStr("G2")) & fic6
End If
Workbooks(fic).Close
End If
End Sub
Function ClasseurEstOuvert(strNomFichierComplet As String) As Boolean
Set objExcel = New Excel.Application
With objExcel
' L'instance d'Excel qui porte le fichier ne doit pas être visible
.Visible = False
.Workbooks.Open (strNomFichierComplet)
' Si le classeur est déjà ouvert cette propriété sera à True
ClasseurEstOuvert = .Workbooks(1).ReadOnly
.Quit
End With
' Ne pas oublier de supprimer la référence à Excel
' sinon une autre instance fantôme hantera votre système...
Set objExcel = Nothing
End Function
Bonjour Guy,
Merci pour tes explications, tu trouveras ci joint le code VBA, si des instructions te choquent, n'hésite pas, c'est à aujourd'hui mon premier code VBA sans avoir eu de formation...
Cdlt
Olivier
|
Didier FOURGEOT