Macro avec condition

Résolu/Fermé

Nilec - 27 avril 2015 à 17:43
Nilec - 28 avril 2015 à 17:56

Bonjour,
J'ai besoin d'aide pour ma macro. Dans une macro j'ouvre un fichier que plusieurs personnes peuvent ouvrir. Si le fichier est en utilisation, j'aurai le message que le fichier est en utilisation par un autre utilisateur et je dois répondre à la question ouvrir en lecture seule et ma macro copie des données dans ce fichier, donc je ne dois pas être en lecture seule. Ce que je voudrais c'est que si le fichier est ouvert, il y aura un message dans la macro qui dit que le fichier est en utilisation, de réessayer plus tard et de mettre fin à la macro afin de ne pas entrer en débug.
Je vous remercie pour votre aide
Nilec

A voir également:

Macro avec condition
Excel cellule couleur si condition texte - Guide
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
Macro word - Guide
Jitbit macro recorder - Télécharger - Confidentialité
Macro logiciel - Télécharger - Organisation

3 réponses

Réponse 1 / 3

Le Pingou Messages postés 12227 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 6 janvier 2025 1 454
28 avril 2015 à 16:05

Bonjour,
Est-il possible de voir votre macro... ?

Nilec
28 avril 2015 à 17:04

Bonjour,
Voici la macro, c'est au moment ou j'ouvre le fichier Liste des numéros ch émis année fiscale 2015.xlsm" que je voudrais m'assurer que le fichier n'est pas ouvert. Si il est en utilisation par un autre utilisateur, je voudrais un message que le fichier est en utilisation et de sortir de la macro (Exit Sub )
Merci beaucoup pour votre aide. Je cherche depuis longtemps et je ne réussis pas à mettre la bonne commande.

Sub DonnéesCheque()

[chèque!C295] = Application.UserName

Dim Nom As String
Dim NoEmployé As String
Dim Période As String
Dim Chèque As String
Nom = InputBox("Inscrire Prénom et Nom Employé", "Saisie du Nom")
Range("B2") = Nom
NoEmployé = InputBox("Inscrire No Employé", "Saisie du NoEmployé")

Range("F2") = NoEmployé

Période = InputBox("Inscrire No Période 2015-?? ", "Saisie du Période")

Range("G2") = Période

Chèque = InputBox("Choisir 1 avec dépôt ou 2 sans dépôt", "Saisie du Chèque")

Range("H2") = Chèque

If Dir("U:\Cheque Émis\Original\Nicole\Macro\Liste des numéros ch émis année fiscale 2015.xlsm") <> "" Then
If MsgBox("Fichier existe, voulez vous le remplacer", vbYesNo) <> vbYes Then Exit Sub
Application.DisplayAlerts = False
End If

'Workbooks.Open Filename:= _
"C:\Users\Nicole\Ch émis\Liste des numéros ch émis année fiscale 2015.xlsm"

Workbooks.Open "U:\Cheque Émis\Original\Nicole\Macro\Liste des numéros ch émis année fiscale 2015.xlsm"

'Dim Fichier As String
'Dim Chemin As String, Commande As String
'Chemin = "U:\Cheque Émis\Original\Nicole\Macro"

'Dim Xl As Excel.Application, Wk As Workbook
'Dim WB As Workbook 'Dim Wbk
'On Error Resume Next
'Set Wbk = Workbooks("U:\Cheque Émis\Original\Nicole\Macro\Liste des numéros ch émis année fiscale 2015.xlsm")
'If Err <> 0 Then
'pas ouvert -> on ouvre
'Workbooks.Open "U:\Cheque Émis\Original\Nicole\Macro\Liste des numéros ch émis année fiscale 2015.xlsm"
'Else: MsgBox "déjà ouvert"
'Exit Sub

'Dim Wk As Workbook
'x = "Liste des numéros ch émis année fiscale 2015"
'On Error Resume Next
'Set Wk = Workbooks("Liste des numéros ch émis année fiscale 2015" & ".xlsm")
'If IsFileOpen("U:\Cheque Émis\Original\Nicole\Macro\Liste des numéros ch émis année fiscale 2015.xlsm") Then
'MsgBox "LE FICHIER EST EN COUR D'UTILISATION, RECOMMANCER DANS QUELQUES INSTANTS"
'Exit Sub
'Else
'Workbooks.Open Filename:= _
"U:\Cheque Émis\Original\Nicole\Macro\Liste des numéros ch émis année fiscale 2015.xlsm"
'End If
'If IsFileOpen("U:\Cheque Émis\Original\Nicole\Macro\Liste des numéros ch émis année fiscale 2015.xlsm") Then
'MsgBox "LE FICHIER EST EN COUR D'UTILISATION, RECOMMANCER DANS QUELQUES INSTANTS"
'Exit Sub

' Else
'MsgBox "O.K"
'Workbooks.Open "U:\Cheque Émis\Original\Nicole\Macro\Liste des numéros ch émis année fiscale 2015.xlsm"
'End If

'Workbooks.Open Filename:= _
"U:\Cheque Émis\Original\Nicole\Macro\Liste des numéros ch émis année fiscale 2015.xlsm"

'ChDir "U:\Cheque Émis\Original\Nicole\Macro"

'Windows("Liste des numéros ch émis année fiscale 2015.xlsm").Activate
Range("h12:i12").Select
Selection.Copy
Range("A1048576").End(xlUp).Offset(1, 0).Select
ActiveCell.Offset(0, 10).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Select
ActiveCell.Offset(0, -10).Select
ActiveCell.FormulaR1C1 = "=TODAY()"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "='Louis Groleau 2015-01-21.xlsmcode'!R2C7"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "='Louis Groleau 2015-01-21.xlsmcode'!R2C6"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "='Louis Groleau 2015-01-21.xlsmcode'!R2C2"
ActiveCell.Offset(0, 4).Select
ActiveCell.FormulaR1C1 = _
"=IF('Louis Groleau 2015-01-21.xlsmcode'!R2C8=1,RC11+1,"""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = _
"=IF('Louis Groleau 2015-01-21.xlsmcode'!R2C8=2,RC[3]+1,"""")"
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "='Louis Groleau 2015-01-21.xlsmcode'!R1C13"
ActiveCell.Offset(0, 3).Select
ActiveCell.FormulaR1C1 = "=IF(RC[-5]="""",RC[-4],RC[-5])"
Selection.Copy
Windows("#0000 Louis Groleau 2015-01-21.xlsm").Activate
Range("I2:K2").Select
Selection.PasteSpecial Paste:=xlPasteAllMergingConditionalFormats, Operation _
:=xlNone, SkipBlanks:=False, Transpose:=False
Windows("Liste des numéros ch émis année fiscale 2015.xlsm").Activate
Range("A1048576").End(xlUp).Offset(0, 0).Select
ActiveCell.Range(Cells(1, "A"), Cells(1, "M")).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Range(Cells(1, "K"), Cells(1, "M")).Select
Selection.ClearContents
Range("A13").Select
ActiveWorkbook.Save
ActiveWorkbook.Close

Windows("#0000 Louis Groleau 2015-01-21.xlsm").Activate
Sheets("chèque").Select
If Dir(Range("B300") & "\" & Range("b301") & ".xls") <> "" Then
If MsgBox(" ATTENTION ATTENTION ATTENTION FICHIER EXISTANT, OUI = ÉCRASER NON =VÉRIFIER NO DE PROJET ET RECOMMENCER ", vbYesNo) <> vbYes Then Exit Sub
Application.DisplayAlerts = False
End If
ActiveWorkbook.SaveAs (Range("B300") & "\" & Range("b301") & ".xls")
Sheets("code").Select
ActiveSheet.DrawingObjects.Delete
Range("D4").Select
'Windows("#0000 Louis Groleau 2015-01-21.xlsm").Activate
'Workbooks.Open Filename:="G:\DSA-PAIE_ET_COMPTABILITE\PAIE\CHEQUE EMIS\Ch. émis 2015\Chèques émis 2015" & Range("b301") & ".xls"

End Sub

Nilec
28 avril 2015 à 17:20

Réponse 2 / 3

Le Pingou Messages postés 12227 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 6 janvier 2025 1 454
28 avril 2015 à 17:12

Bonjour,
Merci pour le code.
Cependant vous avez un doublon ici et c'est sur ce dernier, ou vous êtes inscrite, que je posterai ma réponse.

Réponse 3 / 3

Le Pingou Messages postés 12227 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 6 janvier 2025 1 454
28 avril 2015 à 17:47

Bonjour,
Merci de relire encore une fois mon message.

Nilec
28 avril 2015 à 17:56

Bonjour,
Dois-je vous faire parvenir la macro à nouveau ?

Discussions similaires

Copie automatique tableau Excel sans macro

faire une boucle sans VBA

formule excel de soustraction selon condition

Transformer un chiffre en lettres dans excel sans macro

recup couleur de cellule sans macro