كود لكتابة النص في الأشكال
Write Inside Shapes Using VBA
اكتب النص في الأشكال باستخدام VBA
يمكنك كتابة أحرف داخل الأشكال بالطريقة العادية
ولكن من خلال كود برمجي تستطيع كتابة اسمك ويظهر كل حرف داخل شكل أنت تقوم بإختياره
ثم قم بإستدعاء الكود البرمجي التالي
سيظهر لك صندوق ادخال قم بإدخال النص الذى تريده ثم اضغط Ok
الكود البرمجي المستخدم :
'Permits any person to use this code provided that the source is mentioned
'https://elshriefacademy.blogspot.com
Sub Write_In_Shapes()
Const pi = 3.1416
Dim i As Integer
Dim x As Single, y As Single
Dim z As Single
Dim rng As Range
Dim n As Single
Dim k As Integer
Dim sSize As Single
Dim sh As Shape
Dim sName As String
Dim StartLeft As Integer
Dim StartTop As Integer
StartLeft = ActiveCell.Left
StartTop = ActiveCell.Top
sName = InputBox("Enter your text here")
n = 3
k = Len(sName)
sSize = Application.InchesToPoints(1)
Randomize Timer
z = 0#
For i = 1 To k
If Mid(sName, i, 1) <> " " Then
x = n * i / k
x = Application.InchesToPoints(x)
If Int(1 * Rnd) = 0 Then
z = z + 0.2
Else
z = z - 0.2
End If
y = Application.InchesToPoints(z)
Set sh = ActiveSheet.Shapes.AddShape _
(msoShapeWave, StartLeft + x, StartTop + y, sSize, sSize)
sh.Fill.ForeColor.RGB = RGB(255, 0, 0)
sh.Fill.Visible = msoTrue
sh.TextFrame.Characters.Text = Mid(sName, i, 1)
sh.TextFrame.Characters.Font.Size = 12
sh.TextFrame.Characters.Font.Name = "Arial"
sh.TextFrame.Characters.Font.Bold = True
sh.TextFrame.Characters.Font.Color = vbWhite
End If
Next i
End Sub
السطر البرمجي التالي خاص بالتحكم فى المسافة بين كل شكل
n = 3
السطر البرمجي التالي خاص بالتحكم فى حجم الشكل (لاحظ الرقم 1 ) حاول تغييره وستعرف ذلك
sSize = Application.InchesToPoints(1)
السطر البرمجي التالي خاص بالشكل ، وسنعرض قائمة بجميع أنواع الأشكال المتاحة
اسم الشكل ذا اللون الأحمر
Set sh = ActiveSheet.Shapes.AddShape _
(msoShapeWave, StartLeft + x, StartTop + y, sSize, sSize)
الأسطر البرمجية التالية خاصة
باللون الأحمر الذى يظهر كخلفية للشكل ، وحجم الخط ، ونوع الخط ، وسماكه الخط ، ..الخ
sh.Fill.ForeColor.RGB = RGB(255, 0, 0)
sh.Fill.Visible = msoTrue
sh.TextFrame.Characters.Text = Mid(sName, i, 1)
sh.TextFrame.Characters.Font.Size = 12
sh.TextFrame.Characters.Font.Name = "Arial"
sh.TextFrame.Characters.Font.Bold = True
sh.TextFrame.Characters.Font.Color = vbWhite
قائمة بجميع مسميات الأشكال المتاحة وبجواره القيمة الخاصة به
msoShape16pointStar 94
msoShape24pointStar 95
msoShape32pointStar 96
msoShape4pointStar 91
msoShape5pointStar 92
msoShape8pointStar 93
msoShapeActionButtonBackorPrevious 129
msoShapeActionButtonBeginning 131
msoShapeActionButtonCustom 125
msoShapeActionButtonDocument 134
msoShapeActionButtonEnd 132
msoShapeActionButtonForwardorNext 130
msoShapeActionButtonHelp 127
msoShapeActionButtonHome 126
msoShapeActionButtonInformation 128
msoShapeActionButtonMovie 136
msoShapeActionButtonReturn 133
msoShapeActionButtonSound 135
msoShapeArc 25
msoShapeBalloon 137
msoShapeBentArrow 41
msoShapeBentUpArrow 44
msoShapeBevel 15
msoShapeBlockArc 20
msoShapeCan 13
msoShapeChevron 52
msoShapeCircularArrow 60
msoShapeCloudCallout 108
msoShapeCross 11
msoShapeCube 14
msoShapeCurvedDownArrow 48
msoShapeCurvedDownRibbon 100
msoShapeCurvedLeftArrow 46
msoShapeCurvedRightArrow 45
msoShapeCurvedUpArrow 47
msoShapeCurvedUpRibbon 99
msoShapeDiamond 4
msoShapeDonut 18
msoShapeDoubleBrace 27
msoShapeDoubleBracket 26
msoShapeDoubleWave 104
msoShapeDownArrow 36
msoShapeDownArrowCallout 56
msoShapeDownRibbon 98
msoShapeExplosion1 89
msoShapeExplosion2 90
msoShapeFlowchartAlternateProcess 62
msoShapeFlowchartCard 75
msoShapeFlowchartCollate 79
msoShapeFlowchartConnector 73
msoShapeFlowchartData 64
msoShapeFlowchartDecision 63
msoShapeFlowchartDelay 84
msoShapeFlowchartDirectAccessStorage 87
msoShapeFlowchartDisplay 88
msoShapeFlowchartDocument 67
msoShapeFlowchartExtract 81
msoShapeFlowchartInternalStorage 66
msoShapeFlowchartMagneticDisk 86
msoShapeFlowchartManualInput 71
msoShapeFlowchartManualOperation 72
msoShapeFlowchartMerge 82
msoShapeFlowchartMultidocument 68
msoShapeFlowchartOffpageConnector 74
msoShapeFlowchartOr 78
msoShapeFlowchartPredefinedProcess 65
msoShapeFlowchartPreparation 70
msoShapeFlowchartProcess 61
msoShapeFlowchartPunchedTape 76
msoShapeFlowchartSequentialAccessStorage 85
msoShapeFlowchartSort 80
msoShapeFlowchartStoredData 83
msoShapeFlowchartSummingJunction 77
msoShapeFlowchartTerminator 69
msoShapeFoldedCorner 16
msoShapeHeart 21
msoShapeHexagon 10
msoShapeHorizontalScroll 102
msoShapeIsoscelesTriangle 7
msoShapeLeftArrow 34
msoShapeLeftArrowCallout 54
msoShapeLeftBrace 31
msoShapeLeftBracket 29
msoShapeLeftRightArrow 37
msoShapeLeftRightArrowCallout 57
msoShapeLeftRightUpArrow 40
msoShapeLeftUpArrow 43
msoShapeLightningBolt 22
msoShapeLineCallout1 109
msoShapeLineCallout1AccentBar 113
msoShapeLineCallout1BorderandAccentBar 121
msoShapeLineCallout1NoBorder 117
msoShapeLineCallout2 110
msoShapeLineCallout2AccentBar 114
msoShapeLineCallout2BorderandAccentBar 122
msoShapeLineCallout2NoBorder 118
msoShapeLineCallout3 111
msoShapeLineCallout3AccentBar 115
msoShapeLineCallout3BorderandAccentBar 123
msoShapeLineCallout3NoBorder 119
msoShapeLineCallout4 112
msoShapeLineCallout4AccentBar 116
msoShapeLineCallout4BorderandAccentBar 124
msoShapeLineCallout4NoBorder 120
msoShapeMixed -2
msoShapeMoon 24
msoShapeNoSymbol 19
msoShapeNotchedRightArrow 50
msoShapeNotPrimitive 138
msoShapeOctagon 6
msoShapeOval 9
msoShapeOvalCallout 107
msoShapeParallelogram 2
msoShapePentagon 51
msoShapePlaque 28
msoShapeQuadArrow 39
msoShapeQuadArrowCallout 59
msoShapeRectangle 1
msoShapeRectangularCallout 105
msoShapeRegularPentagon 12
msoShapeRightArrow 33
msoShapeRightArrowCallout 53
msoShapeRightBrace 32
msoShapeRightBracket 30
msoShapeRightTriangle 8
msoShapeRoundedRectangle 5
msoShapeRoundedRectangularCallout 106
msoShapeSmileyFace 17
msoShapeStripedRightArrow 49
msoShapeSun 23
msoShapeTrapezoid 3
msoShapeUpArrow 35
msoShapeUpArrowCallout 55
msoShapeUpDownArrow 38
msoShapeUpDownArrowCallout 58
msoShapeUpRibbon 97
msoShapeUTurnArrow 42
msoShapeVerticalScroll 101
msoShapeWave 103