|
Cette procédure permet d'afficher rapidement des cadres de dessins avec comme propriété d'appliquer le nom de la cellule d'entête...s'adapte selon la largeur de chaque colonne... 
Dans cette procédure, la macro "Carres" affiche les cadres et la macro "EffaceShapes" les efface...
'************************************
'partie à coller dans un module
'************************************
Option Explicit
'Ti 25/11/03
Sub Carres()
On Error Resume Next
Dim Plage As Range, Cel As Range
Dim Largeur As Long, Top As Long, Left As Long
Application.ScreenUpdating = False
With F1
Set Plage = .Range("B3", .Range("B3").End(xlToRight))
For Each Cel In Plage
Largeur = Cel.Width - 10
Top = Cel.Offset(1, 0).Top + 5
Left = Cel.Left + 5
With .Shapes.AddShape(msoShapeRectangle, Left, Top, Largeur, Largeur)
.Name = Cel.Value
.TextFrame.Characters.Text = Cel.Value
.TextFrame.HorizontalAlignment = xlCenter
End With
Next Cel
End With
Application.ScreenUpdating = True
End Sub
Sub EffaceShapes()
Dim Shp As Shape
With F1
For Each Shp In .Shapes
If Not Shp.Type = msoOLEControlObject Then Shp.Delete
Next Shp
End With
End Sub
Date de création : 24/05/2005 - 19:23
Dernière modification : 25/05/2005 - 22:02
Catégorie : Divers
Page lue 3704 fois
 Prévisualiser la page
 Imprimer la page
|
|
OOo
OOo
Membres: 1661
Membre en ligne: 0
Anonymes en ligne: 82
Haut 
