Adicionado em: | 15/05/2011 |
Modificado em: | 15/05/2011 |
Tamanho: | Vazio |
Downloads: | 1558 |
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
Adicionado em: | 01/01/2012 |
Modificado em: | 01/01/2012 |
Tamanho: | Vazio |
Downloads: | 962 |
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.
Adicionado em: | 18/01/2012 |
Modificado em: | 18/01/2012 |
Tamanho: | Vazio |
Downloads: | 934 |
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.
Adicionado em: | 04/02/2012 |
Modificado em: | 04/02/2012 |
Tamanho: | Vazio |
Downloads: | 1096 |
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.
Adicionado em: | 23/06/2012 |
Modificado em: | 23/06/2012 |
Tamanho: | Vazio |
Downloads: | 761 |
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
Adquira já o Acesso Imediato
à Area de Membros
Aprenda Excel VBA com Simplicidade de
códigos e Eficácia, Escrevendo Menos e
Fazendo Mais.
'-------------------------------------'
Entrega Imediata:
+ 500 Video Aulas MS Excel VBA
+ 35.000 Planilhas Excel e VBA
+ Coleção 25.000 Macros MS Excel VBA
+ 141 Planilhas Instruções Loops
+ 341 Planilhas WorksheetFunctions(VBA)
+ 04 Módulos Como Fazer Excel VBA
+ Curso Completo MS Excel VBA
+ Planilhas Inteligentes
<script type="text/javascript"><!--
google_ad_client = "ca-pub-2317234650173689";
/* retangulo 336 x 280 */
google_ad_slot = "0315083363";
google_ad_width = 336;
google_ad_height = 280;
//-->
</script>
<script type="text/javascript"
src="http://pagead2.googlesyndication.com/pagead/show_ads.js">
</script>
Aprenda tudo sobre o Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel,
Sobre as WorksheetFunctions Funções de Planilhas que retornam valores do VBA