http://www.vbex.ru/index.php?action=history&feed=atom&title=VBA%2FExcel%2FAccess%2FWord%2FExcel%2FShapes
VBA/Excel/Access/Word/Excel/Shapes - История изменений
2026-04-07T07:05:32Z
История изменений этой страницы в вики
MediaWiki 1.30.0
http://www.vbex.ru/index.php?title=VBA/Excel/Access/Word/Excel/Shapes&diff=1596&oldid=prev
в 16:33, 26 мая 2010
2010-05-26T16:33:00Z
<p></p>
<table class="diff diff-contentalign-left" data-mw="interface">
<tr style="vertical-align: top;" lang="ru">
<td colspan="1" style="background-color: white; color:black; text-align: center;">← Предыдущая</td>
<td colspan="1" style="background-color: white; color:black; text-align: center;">Версия 16:33, 26 мая 2010</td>
</tr><tr><td colspan="2" style="text-align: center;" lang="ru"><div class="mw-diff-empty">(нет различий)</div>
</td></tr></table>
http://www.vbex.ru/index.php?title=VBA/Excel/Access/Word/Excel/Shapes&diff=1597&oldid=prev
Admin: 1 версия
2010-05-26T12:47:34Z
<p>1 версия</p>
<p><b>Новая страница</b></p><div>==Add a new shape==<br />
<br />
<br />
<br />
<br />
<!-- start source code --><br />
<br />
<source lang="vb"><br />
<br />
Private Sub btnShowAllAutoShapes_Click()<br />
Dim i&<br />
On Error Resume Next<br />
For i = 0 To 136<br />
ActiveSheet.Shapes.AddShape i + 1, 40 + 50 * (i Mod 12), 50 + 50 * (i \ 12), 40, 40<br />
Next<br />
End Sub<br />
</source><br />
<br />
<br />
<br />
<br />
==Add a rectangle==<br />
<br />
<br />
<br />
<br />
<!-- start source code --><br />
<br />
<source lang="vb"><br />
<br />
Sub AddRectangle()<br />
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, 10, 10, 200, 100).TextFrame<br />
.Characters.Text = "This is a rectangle"<br />
.HorizontalAlignment = xlHAlignCenter<br />
.VerticalAlignment = xlVAlignCenter<br />
End With<br />
End Sub<br />
</source><br />
<br />
<br />
<br />
<br />
==Delete all shapes==<br />
<br />
<br />
<br />
<br />
<!-- start source code --><br />
<br />
<source lang="vb"><br />
<br />
Private Sub btnDeleteShapes_Click()<br />
Dim s As Shape<br />
For Each s In ActiveSheet.Shapes<br />
If s.Type = msoAutoShape Or s.Type = msoLine Then s.Delete<br />
Next<br />
End Sub<br />
</source><br />
<br />
<br />
<br />
<br />
==Display auto shapes==<br />
<br />
<br />
<br />
<br />
<!-- start source code --><br />
<br />
<source lang="vb"><br />
<br />
Sub DisplayAutoShapes()<br />
Dim sh As Shape<br />
Dim i As Integer<br />
Set sh = ActiveSheet.Shapes.AddShape(1, 100, 100, 72, 72)<br />
For i = 1 To 138<br />
sh.AutoShapeType = i<br />
sh.Visible = True<br />
ActiveSheet.Cells(1, 1).Value = sh.AutoShapeType<br />
Delay 0.5<br />
Next i<br />
End Sub<br />
</source><br />
<br />
<br />
<br />
<br />
==Draw a star==<br />
<br />
<br />
<br />
<br />
<!-- start source code --><br />
<br />
<source lang="vb"><br />
<br />
Private Sub btnStar_Click()<br />
Dim degree#<br />
Dim s As Shape<br />
Const Pi = 3.1415927<br />
Randomize<br />
For degree = 0 To 2 * Pi Step Pi / 12<br />
Set s = ActiveSheet.Shapes.AddLine(200, 200, 200 + 100 * Sin(degree), 200 + 100 * Cos(degree))<br />
s.Line.EndArrowheadStyle = msoArrowheadTriangle<br />
s.Line.EndArrowheadLength = msoArrowheadLengthMedium<br />
s.Line.EndArrowheadWidth = msoArrowheadWidthMedium<br />
s.Line.ForeColor.RGB = RGB(Rnd * 255, Rnd * 255, Rnd * 255)<br />
Next<br />
End Sub<br />
</source></div>
Admin