Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

10 Mayıs 2008 Cumartesi

Selection Shapes

 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    If ActiveCell.Column = 2 Then
        With ActiveSheet
            .Unprotect
            If ActiveCell.Value <> "" Then
                .Shapes("Description").Cut
                '.DrawingObjects.Delete
                .Shapes.AddShape(msoShapeFlowchartDocument, 210, 140.25, 210, 116.25).Name = "Description"
                With .Shapes("Description")
                    .Top = ActiveCell.Offset(0, 1).Rows.Top
                    .Left = ActiveCell.Offset(1, 1).Rows.Left
                    .Fill.PresetGradient 1, 1, 4
                    .Line.Visible = msoFalse
                    .Shadow.Type = msoShadow21
                    .Reflection.Type = msoReflectionType5
                    With .Glow
                        .Color.ObjectThemeColor = msoThemeColorAccent1
                        .Color.TintAndShade = 0
                        .Color.Brightness = 0
                        .Transparency = 0.599999994
                        .Radius = 18
                    End With
                    With .TextFrame
                        .Characters.Text = Target.Value
                        With .Characters(Start:=1, Length:=5).Font
                            .Name = "Arial Narrow"
                            .FontStyle = "Bold"
                            .Size = 36
                            .Strikethrough = False
                            .Superscript = True
                            .Subscript = True
                            .OutlineFont = True
                            .Shadow = True
                            .Underline = xlUnderlineStyleNone
                            .ColorIndex = 36
                        End With
                        With .Characters(Start:=7, Length:=10).Font
                            .Name = "Arial Narrow"
                            .FontStyle = "Bold"
                            .Size = 36
                            .Strikethrough = False
                            .Superscript = True
                            .Subscript = True
                            .OutlineFont = True
                            .Shadow = True
                            .Underline = xlUnderlineStyleNone
                            .ColorIndex = 2
                        End With
                    End With
                End With
            Else
                .Shapes("Description").Cut
                '.DrawingObjects.Delete
            End If
            .Protect
        End With
    End If
End Sub
 

Hiç yorum yok:

Blog Arşivi

Bu gadget'ta bir hata oluştu

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul