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 !
Salut Sylvanu,
Exact, mais si c'est spécifique à 2007je laisse tomber. Ces problèmes d'incompatibilité sont agaçant et difficile à cerner.
' =====================================
' 3D
' =====================================
With shp.ThreeD
.Visible = msoTrue
.BevelTopType = msoBevelCircle
.BevelTopDepth = 3
.BevelTopInset = 2
End With
' =========================================================
' CREATION GENERIQUE
' =========================================================
Sub CreatePremiumButton( _
ByVal BtnName As String, _
ByVal Caption As String, _
ByVal PosX As Double, _
ByVal PosY As Double, _
ByVal BtnWidth As Double, _
ByVal BtnHeight As Double, _
ByVal Style As BTN_STYLE, _
ByVal MacroToCall As String, _
Font As BTN_FONT, _
Optional ByVal BaseColor As Long = -1, _
Optional SizeAuto As Boolean = False)
Dim ws As Worksheet, shp As Shape
Set ws = ActiveSheet
' Suppression ancien bouton
On Error Resume Next
ws.Shapes(BtnName).Delete
On Error GoTo 0
' Création
Set shp = ws.Shapes.AddShape( _
Type:=msoShapeRoundedRectangle, _
left:=PosX, _
top:=PosY, _
Width:=BtnWidth, _
height:=BtnHeight)
shp.Name = BtnName
' =========================================
' TEXTE
' =========================================
shp.TextFrame2.TextRange.Text = Caption
With shp.TextFrame2.TextRange.Font
.Name = Font.Name
.Size = Font.Size
.Fill.ForeColor.RGB = Font.Color
.Bold = Font.Bold
.Italic = Font.Italic
End With
'**********************************************************************
'evite le wrap text si le texte est trop grand de quelque milimètres
With shp.TextFrame2
.MarginLeft = 0
.MarginRight = 0
.MarginTop = 0
.MarginBottom = 0
.WordWrap = msoFalse
.VerticalAnchor = msoAnchorMiddle
.TextRange.ParagraphFormat.Alignment = msoAlignCenter
If SizeAuto Then .AutoSize = msoAutoSizeShapeToFitText
End With
'***********************************************************************
shp.Line.Visible = msoFalse
' =========================================
' STYLE
' =========================================
ApplyButtonStyle shp, Style, BaseColor
' =========================================
' TAGS POUR ANIMATION
' =========================================
If Len(shp.AlternativeText) = 0 Then
shp.AlternativeText = MacroToCall & "|1|" & _
RGBToStr(shp.Fill.ForeColor.RGB) & "|" & _
RGBToStr(shp.Fill.BackColor.RGB) & "|" & _
RGBToStr(shp.TextFrame2.TextRange.Font.Fill.ForeColor.RGB)
End If
' =========================================
' ACTION
' =========================================
shp.OnAction = "PremiumButtonClick"
End SubSub test()
'test en autosize
Dim MyFont As BTN_FONT, x As Long
MyFont = DefaultFont()
MyFont.Size = 14
CreatePremiumButton _
"BTN_SAVE" & CStr(x), _
ChrW(10003) & " Enregistrer Sous ", _
20 + (x * 130), 20, _
120 - (x * 15), 30 - (x * 4), _
btn_blue, _
"ActionSave", _
MyFont, _
0, _
True
End Sub'**********************************************************************
'evite le wrap text si le texte est trop grand de quelque milimètres
With shp.TextFrame2
.MarginLeft = 0
.MarginRight = 0
.MarginTop = 0
.MarginBottom = 0
.WordWrap = msoFalse
.VerticalAnchor = msoAnchorMiddle
.TextRange.ParagraphFormat.Alignment = msoAlignCenter
If SizeAuto Then
'.AutoSize = msoAutoSizeShapeToFitText
shp.Width = .TextRange.BoundWidth + 8
shp.Height = .TextRange.BoundHeight + 8
End If
End With
'***********************************************************************Salut patricktoulon,
