Problème de code

[picronte]

Bonjour le fil,
J'ai un sousis de code depuis que je suis passé en excel 2010 le fichier se boque régulierement,
Image en C44 ne se copie pas automatiquement je suis obligé d'ouvrir chaque onglet et même la il bloque de temps en temps je repasse par l'onglet modèle.
Pouvez-vous m'aider
ci-joint le code qui a été elaboré en grande parti par le fil
Option Explicit

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim s As Shape
With Sheets("Modèle") 'à adapter
If Sh.Name Like "*x*" Then
For Each s In Sh.Shapes

If s.TopLeftCell.Address = "$C$44" Then s.Delete
Next
For Each s In .Shapes

If s.TopLeftCell.Address = "$C$44" Then s.Copy: Sh.Paste Sh.[C44]
Next
End If
End With

Dim l As Shape, T As Object, F As Object, CF, CL
For Each l In Feuil54.Shapes
If l.Name Like "*Rectang*" Then
Set T = l.TextFrame
Set F = T.Characters.Font
CF = l.Fill.ForeColor.RGB 'remplissage
CL = l.Line.ForeColor.RGB 'bordure
Exit For
End If
Next
For Each l In Sh.Shapes
If l.Name Like "*Rectang*" Then
With l.TextFrame
If Left(.Characters.Text, 1) = " " Then Exit For 'évite toute modification
.Characters.Text = T.Characters.Text
'.HorizontalAlignment = T.HorizontalAlignment
'.VerticalAlignment = T.VerticalAlignment
'.ReadingOrder = T.ReadingOrder
'.Orientation = T.Orientation
'.AutoSize = T.AutoSize
With .Characters.Font
.Name = F.Name
.FontStyle = F.FontStyle
.Size = F.Size
.Strikethrough = F.Strikethrough
.Superscript = F.Superscript
.Subscript = F.Subscript
.OutlineFont = F.OutlineFont
.Shadow = F.Shadow
.Underline = F.Underline
.Color = F.Color
End With
End With
l.Fill.ForeColor.RGB = CF
l.Line.ForeColor.RGB = CL
Exit For
End If
Next
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)

If Target.Address = "$B$8" Then Sh.Name = Target

End Sub

 

[Paf]

Re : Problème de code

Bonjour,

Pas facile de lire ce code non indenté, ni tester quoi que soit sans classeur support .

Joignez donc un classeur sans données confidentielles, pour faciliter le diagnostic, vous aurez sans doute davantage de réponses
en apportant des précisions sur ce qu'est sensé faire ce code.

A+

 

[picronte]

Re : Problème de code

Bonjour,
Je viens de réduire le fichier car il y a plus de 80 onglet en espérant que cela suffit
Picronte

 

[Paf]

Re : Problème de code

Re,

Après avoir lu vos précisions sur ce qu'est sensé faire le code et regardé votre classeur, je ne comprends pas

Image en C44 ne se copie pas automatiquement je suis obligé d'ouvrir chaque onglet ...

puisque le code est prévu de faire une copie sur une feuille (du type "*x*") uniquement à l'activation de celle ci.

En aucun cas cette macro n'est prévue pour copier l'image sur l'ensemble des feuilles (du type "*x*") que ce soit en XL 2010 ou antérieur.

Si vous voulez qu'il en soit ainsi il faudra modifier, et le choix de la macro évènementielle (Private Sub Workbook_SheetActivate(ByVal Sh As Object)) peut-être à revoir.

Après plusieurs essais, pas de blocage ni de ' non copie'. Par contre cette macro, sur la feuille qui vient d'être activée, efface l'image 'liée' à C44 puis y copie celle de la feuille modèles si le nom de cette feuille est du type "*x*"; puis, quelque soit le nom de la feuille, recherche les caractéristiques de l'image de type "*Rectang*" dans la feuille modèles, pour les affecter à l'image correspondante de la feuille courante. Or, seules les feuilles de type "*x*" comportent une telle image. Est-il nécessaire d'exécuter ce code pour tout type de feuille?

A+

 

[picronte]

Re : Problème de code

Bonjour,
Merci pour votre réponse.Que suggérez- vous pour modifier le code afin qu'il n'efface pas l'image
Picronte

 

[Paf]

Re : Problème de code

Re,


dites déjà ce que vous voulez que fasse cette macro dans son ensemble;
quelles actions doivent être faites, sur quelles feuilles, en gardant le principe du déclenchement à l'activation de chaque feuille ou bien un bouton qui va traiter l'ensemble des feuilles ?

A+

 

[picronte]

Re : Problème de code

Re,
Donc je dois rajouté un bouton action avec ce code:
Sub Bouton1_Clic()
Dim Ws As Object

For Each Ws In ThisWorkbook.Sheets
Ws.Activate
Next Ws
Feuil54.Activate
End Sub

Picronte

 

[Paf]

Re : Problème de code

Re,

Quand vous serez décidé à fournir les précisions demandées, faites signe !

Bonne continuation

 

[picronte]

Re : Problème de code

re,
je pense que l'on n'arrive pas a se comprendre.
Dans l'onglet modèle tous les mois j'écris un texte dans la bulle (rectangle) et je mets une image qui correspond au texte en C44. Je souhaiterai que cela se recopie automatiquement dans les autres onglets( plus de 80).

 

[Paf]

Re : Problème de code

Re,

Dans l'onglet modèle tous les mois j'écris un texte dans la bulle (rectangle) et je mets une image qui correspond au texte en C44. Je souhaiterai que cela se recopie automatiquement dans les autres onglets( plus de 80).

s'il faut copier dans toutes les feuilles, effectivement il faut boucler sur toutes les feuilles à partir d'un bouton( en feuille modèle par exemple):

Sub Bouton1_Clic()
 Dim Sh As Object
 Dim s As Shape

 With Sheets("Modèle") 'à adapter


 For Each Sh In ThisWorkbook.Sheets  ' Sh pour ne pas avoir à modifier le code existant
     If Sh.Name <> "Modèle" Then
            
         ' inclure le code de Private Sub Workbook_SheetActivate(ByVal Sh As Object)
         ' supprimer    If Sh.Name Like "*x*" Then puisqu'on veut toutes les feuilles
         ' ne pas oublier de supprimer le End If correspondant

     End If
 Next Sh
 Feuil54.Activate
End Sub

Bonne suite

 

[picronte]

Re : Problème de code

Bonjour Paf
Merci pour ta solution,
Cela fonctionne très bien.
Fait-il que je le mets sur le site?
Picronte