Saberexcel - site das macros

Um pequeno simples tutorial(ajuda) imagem do Aplicativo Microsoft Excel VBA(Visual Basic Application) , mostrando o ambiente vbe, como renomear um shapes(autoformas) e ou imagem e também como renomear um módulo vba. (imagens na folha de planilha)
bem simples, mas poderá ajudar alguém...Fiquem com Deus, E_Marcondes








Aprenda tudo sobre o Aplicativo Microsoft Excel VBA, sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel

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 todos 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

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

Saberexcel - site das Macros

Essas macros do Aplicativo Microsoft Excel VBA(Visual Basic Application), adiciona Shapes(Autoformas) retangulares de forma aleatória na folha de planilha.

Option Explicit

Private Type ExcelShapes
vTipo As Integer
vCarregar As Single
vCores As Long
vRange As Range
vRegiaoTamanho As Single
vRangeSobrePosicao As Boolean
End Type

Private vFomaShapes As ExcelShapes
Private numRotations As Integer

Sub Adicionar_Autoformas()
Dim RngVERMELHO As Integer, RngVERDE As Integer, RngAZUL As Integer
'...................'
'Aleatoriamente acrescenta um dos cinco formas possíveis de retangulos.

'...................'
deleta_shapes
Randomize
RngVERMELHO = Int(Rnd * 256)
RngVERDE = Int(Rnd * 256)
RngAZUL = Int(Rnd * 256)
'...................'
'Inicializar propriedades comuns dos locais que compõem todas as formas.

'...................'
vFomaShapes.vTipo = Int(5 * Rnd) + 1
vFomaShapes.vCarregar = 0.5
vFomaShapes.vCores = RGB(RngVERMELHO, RngVERDE, RngAZUL)
vFomaShapes.vRegiaoTamanho = Range("F3").Width
'...................'
'Inicializar o local da forma, então, construí-la
'...................'
IncializeShapes
Criar_Shapes
'If vFomaShapes.vRangeSobrePosicao Then Fimr
[G1].Select
End Sub


Private Sub IncializeShapes()
'...................'
'select case incializa as formas suspensas nos conjuntos de células
'...................'
Select Case vFomaShapes.vTipo
Case Is = 1
Set vFomaShapes.vRange = Range("F3:I3")
Case Is = 2
Set vFomaShapes.vRange = Range("G3:H4")
Case Is = 3
Set vFomaShapes.vRange = Range("F3:H3,H4")
Case Is = 4
Set vFomaShapes.vRange = Range("F3:H3,G4")
Case Is = 5
Set vFomaShapes.vRange = Range("G3:H3, F4:G4")
End Select
End Sub

Private Sub Criar_Shapes()
Dim I As Integer
Dim NovoShapes As Shapes
Dim c As Range
'...................'
'criando um conjunto de quatro retangulos.
'...................'
I = 1
Set NovoShapes = ActiveSheet.Shapes
For Each c In vFomaShapes.vRange
NovoShapes.AddShape(msoShapeRectangle, c.Left, c.Top, _
c.Width, c.Height).Select
Selection.ShapeRange.Line.Weight = vFomaShapes.vCarregar
Selection.ShapeRange.Fill.ForeColor.RGB = vFomaShapes.vCores
Selection.ShapeRange.Name = "Saberexcel" & I
I = I + 1
Next
'...................'
'Verifica se sobrepõe forma, adicionou formas existentes
'...................'
For Each c In vFomaShapes.vRange
If c.Value = "x" Then
vFomaShapes.vRangeSobrePosicao = True
Exit For
End If
Next
End Sub
'...................'

Sub deleta_shapes()
Range("G1").Select
ActiveSheet.Shapes.Range(Array("Saberexcel4", "Saberexcel1")).Select
ActiveSheet.Shapes.Range(Array("Saberexcel4", "Saberexcel1", "Saberexcel2")).Select
ActiveSheet.Shapes.Range(Array("Saberexcel4", "Saberexcel1", "Saberexcel2", "Saberexcel3")). _
Select
Selection.Delete
End Sub



Aprenda tudo sobre o Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos SaberExcel

Saberexcel - site das macros

Essa macro do Aplicativo Microsoft Excel VBA(Visual Basic Application), insere na folha de planilha autoformas um autoformas(shape) na cor marrom gradiente(Degradê)

Sub Inserindo_shapes_degrade_planilha()

Set vDoc = Worksheets(1)

With vDoc.Shapes.AddShape(msoShapeRectangle, _
90, 90, 90, 50).Fill
.ForeColor.RGB = RGB(128, 0, 0)
.BackColor.RGB = RGB(170, 170, 170)
.TwoColorGradient msoGradientHorizontal, 1
End With

End Sub

Aprenda tudo sobre o Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel

Saberexcel - o site de quem precisa aprender Macros Microsoft Excel VBA

Essas macros do Aplicativo Microsoft Excel VBA(Visual Basic Application), juntamente com shapes em forma de (Semafóros) com os sinais vazados para mostrar a FC(Formatação condicional) em determinadas células na folha de planilha, mostra as cores 'Vermelha, Amarela e Verde', limitando intervalos de números representados por porcentagem.

FC - Formatação condicional atribuida à coluna(Q) - a cada 3 células

Fórmulas usadas na caixa de diálogo (FC-Formatação Condicional)

Fórmula usada primeira condição .....: =O7<=ÍNDICE(Limites;2;2)
Fórmula usada segunda condição .....: =E(O7>ÍNDICE(Limites;2;2);O7<ÍNDICE(Limites;3;2))
Fórmula usada terceira condição ......: =E(O7>ÍNDICE(Limites;3;2);O7<ÍNDICE(Limites;4;2)

Imagem da planilha com os shapes (Semaforos) x (Porcentagem)





Essas macros usadas abaixo foi somente para Ilustrar o exemplo para mostrar as imagens desejadas,
eu uso muito essas macros que são muto boas para mostrarmos determinados shapes desejados,
observe que essas macros ocultam o shapes e mostram somente a imagem(shapes) desejado.
Essas macros são retirnadas da nossa Coleção de 15.000 Macros Microsoft Excel VBA, Fórmulas e Funções,
que são excelentes para pesquisas e treinamento VBA.


Coleção 15.000 Macros Microsoft Excel VBA Fórmulas e Funções

Sub Oculta_Shapes()
For i = 1 To 3
On Error Resume Next
With ActiveSheet
.Shapes("saber" & i).Visible = False
End With
Next
[A1].Select
End Sub

'oculta todos os shapes, cujo nome inicia-se com saber(...) e mostra somente o saber1
Sub fc_semafaro_1()
Oculta_Shapes ' vai ocultar todos os shapes que inicia-se com 'saber'
Saber1.Shapes("saber1").Visible = True
End Sub

'Oculta todos os shapes, cujo nome inicia-se com saber(...) e mostra somente o saber2
Sub fc_semafaro2()
Oculta_Shapes ' vai ocultar todos os shapes que inicia-se com 'saber'
Saber1.Shapes("saber2").Visible = True
End Sub

'Oculta todos os shapes, cujo nome inicia-se com saber(...) e mostra somente o saber2
Sub fc_semafaro3()
Oculta_Shapes ' vai ocultar todos os shapes que inicia-se com 'saber'
Saber1.Shapes("saber3").Visible = True
End Sub

Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel

Publicidade
Compre com segurança, garantia e ótimos preços