Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Marco bloquée par le partage du classeur

  • Initiateur de la discussion Crazyo
  • Date de début
C

Crazyo

Guest
Tout d'abord, merci à ce fabuleux site et à tous ces intervenants, il y a peu j'ignorais tout de VBA, un mois plus tard, je commence à bien me débrouiller. Bravo à tous!!!

Bon, voilà mon problème:
Je me suis créé un petit cahier d'appel qui fonctionne parfaitement grace à certaines bonnes volontés de ce site, les 4 autres personnes connectées à notre petit réseau ne peuvent plus s'en passer. Du coup, ils m'ont demandé de faire de même pour les plannings. Donc j'ai mis en forme un tableau par jour, avec les 5 intervenants, et les horraires. J'use de mes nouvelles connaissances en VBA pour faire en sorte que lorsqu'on veut placer un nouveau rendez-vous, il suffit de sélectionner le nombre de cases souhaitées dans sa colonne (chaque case correspond à une demi-heure), on clique sur un petit bouton, ouverture d'Inputbox qui vous demande l'intitulé du rendez-vous etc... Tout marche au poil dans ma version test après quelques corrections, je met le fichier sur le réseau, mais ça marche pas, pourquoi?

Il me met "erreur d'execution 1004" - Impossible de définir la propriété MergeCells de la Classe Range.

Voilà mon code:

Sub Rendezvous()
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Dim NomRDV As String
NomRDV = InputBox("Entrez l'intitulé du Rendez-vous:", "Nouveau Rendez-vous", "Entrez l'intitulé du RDV ici")
ActiveCell.Value = NomRDV
ActiveCell.Interior.ColorIndex = 36
Selection.Merge
End Sub


Sub Rendezvousannulé()
Selection.ClearContents
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.Interior.ColorIndex = 0
Selection.UnMerge
End Sub
 
@

@+Thierry

Guest
Bonjour Crazyo, le Forum

Je ne peux faire de test en réseau pour le moment, mais ce que je sais c'est que le MergeCells a toujours été un souci en VBA... Essaie ceci, où tu noteras que j'ai dégagé pas mal de chose inutile dans ton code vu que par défaut...

Sub Rendezvous()
Dim NomRDV As String
NomRDV = InputBox("Entrez l'intitulé du Rendez-vous:", "Nouveau Rendez-vous", "Entrez l'intitulé du RDV ici")

With Selection
.Interior.ColorIndex = 36
.HorizontalAlignment = xlCenterAcrossSelection
End With
ActiveCell.Value = NomRDV
End Sub

Le xlCenterAcrossSelection fera le même effet visule que le MergeCell sans ses inconvénients... Si çà passe, je n'ai pas testé en réseau...

Bon Aprèm
@+Thierry
 
C

Crazyo

Guest
Merci pour la réponse!!!

Ca bloque plus!!! Par contre, la fusion des cellules me permettait de délimiter chaque rendez vous, as-tu une solution rapide pour que la sélection soit encadrée dans cette optique?
 
@

@+Thierry

Guest
Re Crazyo, le Forum

Encadré... heu oui, essaie ceci :

Sub Rendezvous()
Dim N As Byte
Dim NomRDV As String
NomRDV = InputBox("Entrez l'intitulé du Rendez-vous:", "Nouveau Rendez-vous", "Entrez l'intitulé du RDV ici")

With Selection
.Interior.ColorIndex = 36
.HorizontalAlignment = xlCenterAcrossSelection
For N = 7 To 10
With .Borders(N)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Next
End With
ActiveCell.Value = NomRDV
End Sub

Maintenant, on pourrait aussi protéger la feuille, mais faut voir si utile...

Bon fin d'aprèm
@+Thierry
 

Discussions similaires

Réponses
11
Affichages
650
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…