1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62
| Private Sub UserForm_Initialize()
Me.TextBox1.SetFocus
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub CommandButton2_Click()
Dim L As Single, T As Single, H As Single, W As Single
Dim Shp As Shape
Prod = TextBox1.Text
X = Forme 'Prose probleme ici
If TextBox1.Text = "" Then
MsgBox "Please Select a Product", vbExclamation, "Message Erreur"
Else
ActiveSheet.Unprotect ("1995")
With Worksheets("Main Sheet")
Set Shp = .Shapes.AddShape(msoShapeRoundedRectangle, 525, 45, 89.5, 24.5)
With Shp
' .Fill.ForeColor.RGB = RGB(204, 255, 204)
' .Line.ForeColor.RGB = RGB(0, 0, 0)
.Name = "Forme"
.TextFrame.Characters.Text = Me.TextBox1
.TextFrame.HorizontalAlignment = xlHAlignLeft
.TextFrame.Characters.Font.ColorIndex = xlAutomatic
.TextFrame.Characters.Font.FontStyle = "Bold"
.TextFrame.VerticalAlignment = xlVAlignCenter
.TextFrame.HorizontalAlignment = xlHAlignCenter
.Locked = True
End With
Shp.Select
'Paramètre Texte
With Selection.Font
.Name = "Calibri" '<-- police
.Color = RGB(255, 255, 255)
.Size = 12 '<-- taille
.Bold = True '<-- mise en gras
End With
End With
Unload Me
Sheets("Main Sheet").Select
'Unhide shape new product (Done with Record Macro)
ActiveSheet.Shapes.Range(Array("Horizontal Scroll 96")).Select
ActiveSheet.Shapes.Range(Array("Group 104")).Visible = msoTrue
Application.CommandBars("Selection").Visible = False
ActiveSheet.Protect ("1995")
End If
End Sub |
Partager