Macro dans un fichier partagé

  • Initiateur de la discussion Initiateur de la discussion nak
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

nak

XLDnaute Occasionnel
Bonjour

Voila une macro que je tente d'utiliser dans un fichier partagé:

Private Sub CommandButton1_Click()
If ActiveWorkbook.MultiUserEditing Then
Application.DisplayAlerts = False
ThisWorkbook.ExclusiveAccess
Application.DisplayAlerts = True
End If
Dim cellule As Range, trouve As Range, suite As Range
Set cellule = Range("B22") 'valeur à chercher
With Sheets("codes_créés")
Set suite = .Range("A1").End(xlDown).Offset(1, 0) 'identifie la prochaine cellule vide
Set trouve = .Columns("A").Find(cellule.Value, LookIn:=xlFormulas, lookat:=xlWhole) 'cherche B4 en colonne A
If trouve Is Nothing Then 'si pas trouvé
suite.Value = cellule.Value
Else: MsgBox "Attention, code existant!", vbInformation, "Codification automatique"
Exit Sub
End If
End With
If Not ActiveWorkbook.MultiUserEditing Then
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, _
accessMode:=xlShared
End If
Range("B22").Copy
End Sub




Pour cela je désactive le partage avant son exécution:
If ActiveWorkbook.MultiUserEditing Then
Application.DisplayAlerts = False
ThisWorkbook.ExclusiveAccess
Application.DisplayAlerts = True
End If


Ensuite j'essai de réactiver le partage:
If Not ActiveWorkbook.MultiUserEditing Then
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, _
accessMode:=xlShared
End If

Premier problème excel me demande si je veux écraser le fichier. Moi je voudrais qu'il l'écrase sans ma confirmation.


Deuxième problème quand mon "code existe" je sort de l'exécution de la macro:
Else: MsgBox "Attention, code existant!", vbInformation, "Codification automatique"
Exit Sub

A la place de sortir j'aimerais réactiver le partage en sauvegardant et sans message d'alerte.


Quelqu'un peut-il m'aider SVP

Merci
 
Re : Macro dans un fichier partagé

Personne ne semble avoir la solution 🙁

Pour contourner le problème est-ce possible d'enregistrer ma cellule B22 dans un fichier CSV. Avec les mêmes commande, recherche valeur identique, si il trouve msgbox sinon copie de la cellule B22 dans le CSV.

Par contre l'ouverture du CSV doit ce faire de manière transparente.

Private Sub CommandButton1_Click()
Dim cellule As Range, trouve As Range, suite As Range
Set cellule = Range("B22") 'valeur à chercher
With Sheets("codes_créés") '' ici il faudrait que j'ouvre mon csv
Set suite = .Range("A1").End(xlDown).Offset(1, 0) 'identifie la prochaine cellule vide '' la je ne sais pas
Set trouve = .Columns("A").Find(cellule.Value, LookIn:=xlFormulas, lookat:=xlWhole) 'cherche B4 en colonne A
If trouve Is Nothing Then 'si pas trouvé
suite.Value = cellule.Value
Else: MsgBox "Attention, code existant!", vbInformation, "Codification automatique"
Exit Sub
End If
End With
Range("B22").Copy
End Sub


Quelqu'un peut-il m'aider à modifier cette macro svp ?

Merci
 
Re : Macro dans un fichier partagé

Bonsoir nak,

Par rapport à ton premier message...
Si j'ai bien compris ta demande, voici une solution.
Code:
Private Sub CommandButton1_Click()
    Dim cellule As Range, trouve As Range, suite As Range
        
    [COLOR="Red"]Application.DisplayAlerts = False[/COLOR]
    
    If ActiveWorkbook.MultiUserEditing Then
        ThisWorkbook.ExclusiveAccess
    End If
    
    Set cellule = Range("B22") 'valeur à chercher
    
    With Sheets("codes_créés")
        Set suite = .Range("A1").End(xlDown).Offset(1, 0) 'identifie la prochaine cellule vide
        Set trouve = .Columns("A").Find(cellule.Value, LookIn:=xlFormulas, lookat:=xlWhole) 'cherche B4 en colonne A
        
        If trouve Is Nothing Then 'si pas trouvé
            suite.Value = cellule.Value
[COLOR="red"]'        Else: MsgBox "Attention, code existant!", vbInformation, "Codification automatique"
'        Exit Sub[/COLOR]
        End If
    End With
    
    If Not ActiveWorkbook.MultiUserEditing Then
        ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, _
        accessMode:=xlShared
    End If
    
    Range("B22").Copy

    [COLOR="red"]Application.DisplayAlerts = True[/COLOR]
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
3
Affichages
485
Réponses
2
Affichages
691
Retour