SaberExcel - Aprenda Excel VBA, Site sobre macros, funções, fórmulas e planilhas do Excel VBA planilhas prontas e apostilas para download

Escola Saberexcel VBA Estudos® - Treinamento com Macros, Fórmulas e Funções

Esses macros do Aplicativo Microsoft Excel VBA(Visual Basic Application), insere um shapes(Autoforma) personalizado, usei neste exemplo
uma formatação do shapes - usando o GM(Gravador de Macros) fiz com finalidade didática a formatação de determinadas letras na folha de
planilha, quero que voces observem o poder do GM(Gravador de Macros) que não precisei programar uma só silaba. GM(Gravador de Macros) é o primeiro tema do nosso Curso Completo Microsoft Excel VBA .
Espero que o exemplo possam lhe ser útil.
Fiquem  com Deus, Expedito Marcondes


Sub sbx_inserir_shapes_personalizado()
On Error Resume Next
    ActiveSheet.Shapes.Range(Array("sbx_1")).Delete
    ActiveSheet.Shapes.AddTextEffect _
       (msoTextEffect1, "Escola SaberExcel VBA Estudos®", _
        "Verdana", 40#, msoFalse, _
        msoFalse, 130, 205).Select
    Selection.ShapeRange.Name = "sbx_1"
    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.Solid
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 36
    Selection.ShapeRange.Fill.Transparency = 0.5
    Selection.ShapeRange.Line.Weight = 0.75
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoFalse
    Selection.ShapeRange.IncrementRotation -26.69
    [L1].Select
    Application.Wait Now + TimeValue("00:00:03") 'pausa para execução da proxima macro
    sbx_cores_sbx
End Sub

Sub sbx_deletar_shapes()
On Error GoTo sbxerro
    ActiveSheet.Shapes.Range(Array("sbx_1")).Delete
Exit Sub
sbxerro: MsgBox ("não há shapes para deletar, insira primeiro"), vbCritical, "Escola Saberexcel VBA Estudos®"
End Sub

'macro obtida através do GM(Gravador de Macros), pode fazer o teste ai que vai dar certo.
Sub sbx_cores_sbx()
    ActiveSheet.Shapes.Range(Array("sbx_1")).Select
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(8, 1).Font.Fill
      .Visible = msoTrue
      .ForeColor.RGB = RGB(0, 176, 80)
      .Transparency = 0
      .Solid
    End With
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(8, 1).Font
      .NameComplexScript = "Old English Text MT"
      .NameFarEast = "Old English Text MT"
      .Name = "Old English Text MT"
    End With

    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(9, 1).Font.Fill
      .Visible = msoTrue
      .ForeColor.RGB = RGB(255, 192, 0)
      .Transparency = 0
      .Solid
    End With

    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(10, 1).Font.Fill
      .Visible = msoTrue
      .ForeColor.RGB = RGB(0, 176, 240)
      .Transparency = 0
      .Solid
    End With

    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(11, 1).Font.Fill
      .Visible = msoTrue
      .ForeColor.RGB = RGB(255, 0, 0)
      .Transparency = 0
      .Solid
    End With

    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(12, 1).Font.Fill
      .Visible = msoTrue
      .ForeColor.RGB = RGB(0, 176, 80)
      .Transparency = 0
      .Solid
    End With

    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(13, 1).Font.Fill
      .Visible = msoTrue
      .ForeColor.RGB = RGB(255, 255, 0)
      .Transparency = 0
      .Solid
    End With

    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(13, 1).Font
      .NameComplexScript = "Old English Text MT"
      .NameFarEast = "Old English Text MT"
      .Name = "Old English Text MT"
    End With

    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(14, 1).Font.Fill
      .Visible = msoTrue
      .ForeColor.RGB = RGB(255, 0, 0)
      .Transparency = 0
      .Solid
    End With

    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(15, 1).Font.Fill
      .Visible = msoTrue
      .ForeColor.RGB = RGB(0, 176, 80)
      .Transparency = 0
      .Solid
    End With

    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(16, 1).Font.Fill
      .Visible = msoTrue
      .ForeColor.RGB = RGB(0, 176, 240)
      .Transparency = 0
      .Solid
    End With

    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(17, 1).Font.Fill
      .Visible = msoTrue
      .ForeColor.RGB = RGB(255, 255, 0)
      .Transparency = 0
      .Solid
    End With

    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(19, 1).Font.Fill
      .Visible = msoTrue
      .ForeColor.RGB = RGB(255, 0, 0)
      .Transparency = 0
      .Solid
    End With

    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(20, 1).Font.Fill
      .Visible = msoTrue
      .ForeColor.RGB = RGB(0, 176, 80)
      .Transparency = 0
      .Solid
    End With

    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(21, 1).Font.Fill
      .Visible = msoTrue
      .ForeColor.RGB = RGB(0, 176, 240)
      .Transparency = 0
      .Solid
    End With

    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(30, 1).Font.Fill
      .Visible = msoTrue
      .ForeColor.RGB = RGB(255, 192, 0)
      .Transparency = 0
      .Solid
    End With
    Range("I3").Select
End Sub

 
Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções.



 Baixe o exemplo de planilha contendo os macros acima
Excel vba shapes personalizado escola (25.95 KB)