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

Esse macro(codigo) do Aplicativo Microsoft Excel VBA(Visual Basic Application), insere um shapes(Imagem) em uma autoforma com tamanho determinado. Observe que a primeira retira a linha de borda do shapes.

Sub Inserir_Imagem()
Dim vImagem As String
Dim Sh As Shape
Set Sh = Worksheets("Inserir_Imagem").Shapes.AddShape(msoShapeRectangle, 30, 40, 120, 25)
vImagem = ThisWorkbook.Path & "\Logo.JPG"
Sh.Fill.UserPicture vImagem
End Sub

'Sem as bordas
'Essa macro retira a linha de borda da imagem.
Sub Inserir_imagem_sem_linha()
Dim strImage As String
Dim Sh As Shape
Set Sh = Worksheets("Inserir_Imagem").Shapes.AddShape(msoShapeRectangle, 30, 40, 120, 125)
strImage = ThisWorkbook.Path & "\paisagem.JPG"
Sh.Line.Visible = msoFalse 'retira a linha da borda.
Sh.Fill.UserPicture strImage
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

Escola Saberexcel VBA Estudos - site de quem precisa aprender Macros MS Excel VBA

Esse macro do Aplicativo Microsoft Excel VBA(Visual Basic Application), insere uma determinada imagem em todas as folhas de planilha do livro ativo.
note: o endereço do path(diretorio) da arquivo (jpg) imagem esta no proprio macro, então, faça a correção do caminho do do diretorio>
Espero que o exemplo possa lhe ser útil. Fique com Deus, Expedito Marcondes - 01-01-2012 : 10:29:00
'- - - - - - - - - - - - - - - - - - -'
Sub sbx_insere_imagem_todas_folhas_planihas()
i = InputBox(prompt:="Entre com a célula [ex: b8] ", Title:="Escola Saberexcel VBA Estudos®")
'se caso cancelar a operação nao ocorrerá erro:
If i = cancel Then
Exit Sub
End If

On Error GoTo fim
For n = 1 To Sheets.Count
Sheets(n).Activate
Range(i).Select
ActiveSheet.Pictures.Insert ("C:\Programadores\saberExcel\vba\ATT00004.jpg")
Next n
exit sub
fim:
MsgBox ("ocorreu um erro verifique"), vbCritical, "Escola Saberexcel VBA Estudos®"
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.



 

Esses macros do Aplicativo Microsoft Excel VBA(Visual Basic Application), movimenta uma imagem de acordo com a incrementação de uma instrução for next ( loop ) e decrementa retornando a mensagem, tornando uma mensagem derrolante. Espero que o exemplo possa lhe ser útil.
Fique com Deus, Expedito Marcondes.

Sub Loop_imagem()
On Error Resume Next
ActiveSheet.Shapes("sbx_macro").Visible = True
Set img = ActiveSheet.Shapes("SaberExcel")
For i = 36 To 527
img.Left = i
[E2].Value = i
DoEvents
Next i
For i = 527 To 36 Step -1
img.Left = i
[E2].Value = i
DoEvents
Next i
ActiveSheet.Shapes("sbx_macro").Visible = False
End Sub

Sub Loop_imagem_I()
Set img1 = ActiveSheet.Shapes("abc")
Set img = ActiveSheet.Shapes("Saberexcel")

For i = 36 To 527
img1.Left = i
img.Left = i
[E2].Value = i
DoEvents
Next i

For i = 527 To 36 Step -1
img.Left = i
img1.Left = i
[E2].Value = i
DoEvents
Next i
End Sub

'com esse macro voce poderá indicar a localização desejada de determinado shapes, podendo usar uma condição
'e mostrar um shapes, o exemplo abaixo voce movimenta a imagem a cada interação no objeto barra de rolagem
'exemplo na folha de planiha. Baixe-a no final da página.
Sub inserir_imagem_local()
Set vLocal = ActiveSheet.Shapes("burro")
vLocal.Top = Range("M18").Value '177.75
vLocal.Left = Range("M20").Value '8.75
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.

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

Esses macros do Aplicativo Microsoft Excel VBA(Visual Basic Application), ocultam ou mostram os shapes, observe que nesta coleção de Shapes(Autoformas) imagens usei um temporizador para pausar o giro da instrução Loop For ...Next.
Espero que gostem do Exemplo. fiquem com Deus, Expedito Marcondes

' - - - - - - - - - - - - - - - -'
Sub sbx_oculta_Shapes()
sbx_smile_20_f

For i = 1 To 20
On Error Resume Next
With ActiveSheet
.Shapes("saber" & i).Visible = False
End With
Next i

[A1].Select
End Sub
' - - - - - - - - - - - - - - - -'
Sub sbx_mostrar_shapes()
sbx_oculta_Shapes
For i = 1 To 20
On Error Resume Next

With ActiveSheet
.Shapes("saber" & i).Visible = True
End With
Tempo 0.5
Next i

sbx_oculta_Shapes
sbx_smile_20_t
[A1].Select
End Sub
' - - - - - - - - - - - - - - - -'

Sub Tempo(SbTempo)
Dim VelhoTempo As Variant
If SbTempo < 0.01 Or SbTempo > 300 Then SbTempo = 1

VelhoTempo = Timer
Do
DoEvents
Loop Until Timer - VelhoTempo >= SbTempo
End Sub
' - - - - - - - - - - - - - - - -'
Sub sbx_smile_20_t()
Saber1.Shapes("saberexcel").Visible = True
End Sub
' - - - - - - - - - - - - - - - -'
Sub sbx_smile_20_f()
Saber1.Shapes("saberexcel").Visible = False
End Sub
' - - - - - - - - - - - - - - - -'

'observe que aqui criamos um objeto wordPad para mostrar o macro na tela ou diretamente no VBE(Visual Basic Editor)
Sub sbx_visualizar_macro()
Dim Resposta As String
Resposta = MsgBox("deseja visualizar(tela ou vbe)?" & vbCrLf & " se SIM = Tela" & vbCrLf & " se NAO = VBE", vbYesNo, "Saberexcel - o site das macros")
If Resposta = 6 Then
ActiveSheet.Shapes.Range(Array("macro")).Select
Selection.Verb Verb:=xlPrimary
Else
Application.Goto reference:="sbx_oculta_Shapes"
End If
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.



 

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