Slamet,

Thanks a lot,

kid


2009/3/12 Slamet Harto <slametha...@wiendi.web.id>

>   Kid,
>
> coba pake ini , tinggal rapihin posisinya aja
>
> Option Explicit
> Public Sub GabungShape()
>
> ActiveSheet.Shapes.SelectAll
> Selection.Copy
> Range("A7:A37").PasteSpecial
>
> End Sub
>
> yang ini cuma iseng aja
> Sub CekNamaShapes()
> Dim Shp As Shape
> For Each Shp In ActiveSheet.Shapes
> Shp.Select
> With Selection.ShapeRange
> .ScaleWidth 2, msoFalse, msoScaleFromTopLeft
> .ScaleHeight 2, msoFalse, msoScaleFromTopLeft
>
> .Fill.ForeColor.RGB = _
> RGB(255, 0, 255)
> .Fill.BackColor.RGB = RGB(0, 204, 255)
> .Fill.Patterned msoPatternHorizontalBrick
>
> DoEvents
>
> MsgBox Shp.Name
>
> 'restore shape to its original size
> .ScaleHeight 0.5, msoFalse, msoScaleFromTopLeft
> .ScaleWidth 0.5, msoFalse, msoScaleFromTopLeft
>
> End With
> Next
>
> [A1].Activate
> End Sub
> .
>
> 
>

Reply via email to