0
- Home
- >
- Fórum
Suítes de escritório
Sala destinada para questões, dúvidas e dicas envolvendo pacotes ou suítes de escritório destinados ao Windows: instalação, configuração, desempenho, implementações, suítes Office, Open Office, Libre Office etc.
0
VBA para Excel
Boa tarde !!!!!
Pessoal, estou necessitado de ajuda para criação de uma macro para verificação e marcação conforme abaixo:
Segue arquivo em anexo.
Desde já agradeço.
Pessoal, estou necessitado de ajuda para criação de uma macro para verificação e marcação conforme abaixo:
- Os dados das Plan” Calc Garantias PJ – SIOPI” e “EPR” são retirados de locais diferentes.
- O único parâmetro de identificação entre as 2 Plan’s é a coluna D (CO_TIPOLOGIA) e Coluna G (Tp.Unid.) respectivamente.
- Tomei para este exemplo a “Tipologia” “D1”(colunas já filtradas).
- A Regra é:
- Verificar quais tipologias não tem “Dt.Inc.Reg.” na Coluna J da Plan EPR;
- No exemplo temos 04 tipologias D1 sem a respectiva “Dt.Inc.Reg.”;
- Marcar as 04 tipologias com “SIM” na coluna L da Plan “Calc Garantias PJ – SIOPI” de tipologia D1 e desde que estejam com informação de “Contratada SIOPI” na coluna J;
- Se a marcação “SIM” concluída, retornar para a PLan “EPR” e marcar “OK” na última coluna (“O” - status) – isso para que, se por acaso tiver alguma divergência de quantidade de tipologias, o assistente possa visualizar facilmente (tinha 04 na EPR e somente 03 na Calc Garantias PJ – SIOPI, por exemplo).
- Veja que esta marcação (SIM) alterará o valor final na célula M2.
Segue arquivo em anexo.
Desde já agradeço.
0
Como faço para automatizar a impressão de cortes??
Oi boa noite, desde ja agradeço a atenção!
Bom, estou a alguns dias travada em uma automatização para minha planilha de Excel, preciso gerar uma lista de corte para os setores da empresa que trabalho (Marcenaria, Metalúrgica-Tubo, Metalúrgica-Chapa e Expedição), com a macro eu consigo fazer a automatização de praticamente tudo, a única parte que esta me travando é na troca de códigos (em anexo deixarei um exemplo de como recebo o pedido) até agora não encontrei uma forma de a macro mudar o código, se possível alguém me auxiliar agradeço (abaixo segue descrição do meu processo de trabalho).
minha intenção é automatizar de forma que eu apenas tenha que alimentar a aba "relatório" e após acionar o botão todos os cortes para cada produto em suas devidas quantidades sejam impressos.
vou deixar minimamente preenchido para facilitar o entendimento.
- Recebo o pedido em PDF ou Excel
- Confiro se tem itens novos faço o projeto e lanço os cortes para os devidos setores
-na aba "Plano de Corte" eu digito o código, setor, op, lote, pedido e a quantidade de produtos (por uma formula matemática simples ele multiplica)
-imprimo pra cada setor apenas mudando o filtro
-sigo fazendo isto para todos os produtor
Bom, estou a alguns dias travada em uma automatização para minha planilha de Excel, preciso gerar uma lista de corte para os setores da empresa que trabalho (Marcenaria, Metalúrgica-Tubo, Metalúrgica-Chapa e Expedição), com a macro eu consigo fazer a automatização de praticamente tudo, a única parte que esta me travando é na troca de códigos (em anexo deixarei um exemplo de como recebo o pedido) até agora não encontrei uma forma de a macro mudar o código, se possível alguém me auxiliar agradeço (abaixo segue descrição do meu processo de trabalho).
minha intenção é automatizar de forma que eu apenas tenha que alimentar a aba "relatório" e após acionar o botão todos os cortes para cada produto em suas devidas quantidades sejam impressos.
vou deixar minimamente preenchido para facilitar o entendimento.
- Recebo o pedido em PDF ou Excel
- Confiro se tem itens novos faço o projeto e lanço os cortes para os devidos setores
-na aba "Plano de Corte" eu digito o código, setor, op, lote, pedido e a quantidade de produtos (por uma formula matemática simples ele multiplica)
-imprimo pra cada setor apenas mudando o filtro
-sigo fazendo isto para todos os produtor
0
Erro de compilação procedimento muito grande (VBA Excel).
Boa tarde pessoal estou com problema em um codigo vba algo poderia me ajudar?
Sub DiagramaProdução1A()
'
' novo diagrama produção
'
On Error GoTo TE
Application.ScreenUpdating = False
i = 12
j = 3
counter1 = 14
Do While counter1 <> 0
Cells(i, j).Select
While Not Cells(i, j).Text = "" ' continua enquanto linha não estiver em branco
' Teste de resistividade
If Cells(i + 1, j + 129).Text = "33" Then
ActiveSheet.Shapes.Range(Array("CONTRAPESO").Select
Selection.Copy
Cells(i - 2, j + 2).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 10.5750393701
Selection.ShapeRange.IncrementTop 1.5750393701
Else
End If
If Cells(i, j + 129).Text = "ESTAIADA" Then
'revisão
If Cells(i - 2, j + 1).Text = "R" And Cells(i, j + 1).Text = "MBCR" Then
ActiveSheet.Shapes.Range(Array("ObjectT").Select
Selection.Copy
Cells(i - 2, j).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft -1.4750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.4750393701
PULAR = OK
Else
If Cells(i - 2, j + 1).Text = "R" Then
ActiveSheet.Shapes.Range(Array("ObjectT").Select
Selection.Copy
Cells(i - 2, j).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft -1.4750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.4750393701
PULAR = OK
Else
'montagem
If Cells(i - 2, j + 1).Text = "M" And Cells(i, j + 1).Text = "MBCR" Then
ActiveSheet.Shapes.Range(Array("ObjectTM").Select
Selection.Copy
Cells(i - 2, j).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft -1.4750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.4750393701
PULAR = "OK"
Else
PULAR = "NOK"
If Cells(i - 2, j + 1).Text = "M" Then
ActiveSheet.Shapes.Range(Array("ObjectTM").Select
Selection.Copy
Cells(i - 2, j).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft -1.4750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.4750393701
PULAR = "OK"
Else
PULAR = "NOK"
'montagem incompleta
If Cells(i - 2, j + 1).Text = "MI" Then
ActiveSheet.Shapes.Range(Array("Object 11").Select
Selection.Copy
Cells(i - 2, j).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
PULAR = "OK"
Else
PULAR = "NOK"
End If
End If
End If
End If
End If
'EHS
If j > 3 Then
If Cells(i - 2, j - 3).Text = "G" Then
ActiveSheet.Shapes.Range(Array("Freeform 127").Select
Selection.Copy
Cells(i - 2, j - 3).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Else
End If
Else
End If
'EHS vão vante
If j > 3 Then
If j = 108 Then
If Cells(i - 2, j + 3) = "" And Cells(i + 2, j - 105).Text = "G" Then
ActiveSheet.Shapes.Range(Array("Freeform 127").Select
Selection.Copy
Cells(i - 2, j - 3).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Else
End If
Else
End If
Else
End If
'lançamento
If j > 3 Then
If Cells(i - 1, j - 3).Text = "L" Then
ActiveSheet.Shapes.Range(Array("Freeform 128").Select
Selection.Copy
Cells(i - 2, j - 3).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Else
End If
Else
End If
'lançamento OPGW
If j > 3 Then
If Cells(i - 1, j - 2).Text = "OPGW-L" Then
ActiveSheet.Shapes.Range(Array("Freeform 190").Select
Selection.Copy
Cells(i - 2, j - 3).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Else
End If
Else
End If
'F1
If Cells(i, j + 130).Text = "3" Then
ActiveSheet.Shapes.Range(Array("Imagem 1688").Select
Selection.Copy
Cells(i, j).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Else
End If
'F2
If Cells(i, j + 130).Text = "4" Then
ActiveSheet.Shapes.Range(Array("Imagem 1689").Select
Selection.Copy
Cells(i, j).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Else
End If
' pré montagem
If Cells(i - 2, j + 1).Text <> "R" And Cells(i - 2, j + 1).Text <> "M" And Cells(i - 2, j + 1).Text <> "MI" Then
If Cells(i, j + 128).Text = "1" Then
ActiveSheet.Shapes.Range(Array("Imagem 730").Select
Selection.Copy
Cells(i, j).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Range("Y73".Select
End If
End If
' pré montagem
If Cells(i - 2, j + 1).Text <> "R" And Cells(i - 2, j + 1).Text <> "M" And Cells(i - 2, j + 1).Text <> "MI" Then
If Cells(i, j + 128).Text = "2" Then
ActiveSheet.Shapes.Range(Array("Imagem750").Select
Selection.Copy
Cells(i, j).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Range("Y73".Select
End If
End If
If PULAR = "NOK" Then
ActiveSheet.Shapes.Range(Array("Pizza 83").Select
Selection.Copy
Cells(i - 2, j).Select
ActiveSheet.Paste
' 1° quadrante
' 1° opção
'
If Cells(i - 2, j).Text = "F" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(46, 205, 9)
.Transparency = 0
.Solid
End With
Else
If Cells(i - 2, j).Text = "P" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(147, 119, 103)
.Transparency = 0
.Solid
End With
Else
If Cells(i - 2, j).Text = "0" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 255)
.Transparency = 0
.Solid
End With
Else
If Cells(i - 2, j).Text = "MI" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 0)
.Transparency = 0
.Solid
End With
Else
'sondagem & topografia
If Cells(i - 2, j).Text = "ST" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(112, 48, 160)
.Transparency = 0
.Solid
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 6
End With
Else
End If
'SONDAGEM
If Cells(i - 2, j).Text = "SO" Then
'edita grafico
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 6
End With
Else
End If
'TOPOGRAFIA
If Cells(i - 2, j).Text = "TO" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(112, 48, 160)
.Transparency = 0
.Solid
End With
Else
'CONFERÊNCIA
If Cells(i - 2, j).Text = "COF" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 240)
.Transparency = 0
.Solid
End With
Else
End If
End If
End If
End If
End If
End If
'
' Inicio do 2° quadrante
'
ActiveSheet.Shapes.Range(Array("PIZZA 86").Select
Selection.Copy
Cells(i - 2, j).Select
ActiveSheet.Paste
j = j + 1
If Cells(i - 2, j).Text = "F" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(46, 205, 9)
.Transparency = 0
.Solid
End With
Else
'6² OPÇÃO
If Cells(i - 2, j).Text = "P" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(147, 119, 103)
.Transparency = 0
.Solid
End With
Else
'5² OPÇÃO
If Cells(i - 2, j).Text = "0" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 255)
.Transparency = 0
.Solid
End With
Else
'sondagem & topografia
If Cells(i - 2, j).Text = "ST" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(112, 48, 160)
.Transparency = 0
.Solid
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 6
End With
Else
End If
'SONDAGEM
If Cells(i - 2, j).Text = "SO" Then
'edita grafico
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 6
End With
Else
End If
'TOPOGRAFIA
If Cells(i - 2, j).Text = "TO" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(112, 48, 160)
.Transparency = 0
.Solid
End With
Else
'Conferência
If Cells(i - 2, j).Text = "COF" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 240)
.Transparency = 0
.Solid
End With
Else
End If
End If
End If
End If
End If
j = j - 1
ActiveSheet.Shapes.Range(Array("PIZZA 84").Select
Selection.Copy
Cells(i - 2, j).Select
ActiveSheet.Paste
'
' Inicio do 3° quadrante
'
'5 opção
If Cells(i - 1, j).Text = "F" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(46, 205, 9)
.Transparency = 0
.Solid
End With
Else
'6² OPÇÃO
If Cells(i - 1, j).Text = "P" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(147, 119, 103)
.Transparency = 0
.Solid
End With
Else
'7 opção
If Cells(i - 1, j).Text = "0" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 255)
.Transparency = 0
.Solid
End With
Else
'sondagem & topografia
If Cells(i - 2, j).Text = "ST" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(112, 48, 160)
.Transparency = 0
.Solid
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 6
End With
Else
End If
'SONDAGEM
If Cells(i - 2, j).Text = "SO" Then
'edita grafico
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 6
End With
Else
End If
'TOPOGRAFIA
If Cells(i - 2, j).Text = "TO" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(112, 48, 160)
.Transparency = 0
.Solid
End With
Else
'Conferência
If Cells(i - 2, j).Text = "COF" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 240)
.Transparency = 0
.Solid
End With
Else
End If
End If
End If
End If
End If
ActiveSheet.Shapes.Range(Array("PIZZA 85").Select
Selection.Copy
Cells(i - 2, j).Select
ActiveSheet.Paste
j = j + 1
'
' Inicio do 4° quadrante
'
'1 opção
If Cells(i - 1, j).Text = "F" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(46, 205, 9)
.Transparency = 0
.Solid
End With
Else
'2² OPÇÃO
If Cells(i - 1, j).Text = "P" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(147, 119, 103)
.Transparency = 0
.Solid
End With
Else
'3² OPÇÃO
If Cells(i - 1, j).Text = "0" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 255)
.Transparency = 0
.Solid
End With
Else
'sondagem & topografia
If Cells(i - 2, j).Text = "ST" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(112, 48, 160)
.Transparency = 0
.Solid
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 6
End With
Else
End If
'SONDAGEM
If Cells(i - 2, j).Text = "SO" Then
'edita grafico
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 6
End With
Else
End If
'TOPOGRAFIA
If Cells(i - 2, j).Text = "TO" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(112, 48, 160)
.Transparency = 0
.Solid
End With
Else
'Conferência
If Cells(i - 2, j).Text = "COF" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 240)
.Transparency = 0
.Solid
End With
Else
End If
End If
End If
End If
End If
j = j - 1
'mc1
ActiveSheet.Shapes.Range(Array("Retângulo Arredondado 89").Select
Selection.Copy
Cells(i - 2, j).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 25.272440944
Selection.ShapeRange.IncrementTop 33.036062991
If Cells(i - 2, j).Text = "G" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(49, 197, 213)
.Transparency = 0
.Solid
End With
Else
' 2° opção
If Cells(i - 2, j).Text = "L" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(81, 88, 213)
.Transparency = 0
.Solid
End With
Else
'3 opção
If Cells(i - 2, j).Text = "R" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(184, 88, 115)
.Transparency = 0
.Solid
End With
Else
'4° OPÇÃO
If Cells(i - 2, j).Text = "M" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(242, 50, 30)
.Transparency = 0
.Solid
End With
Else
If Cells(i - 2, j).Text = "MI" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 0)
.Transparency = 0
.Solid
End With
Else
'6² OPÇÃO
If Cells(i + 1, j + 2).Text = "" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 255)
.Transparency = 0
.Solid
End With
Else
' 5° OPÇÃO
If Cells(i + 1, j + 2).Text = "MC" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(46, 205, 9)
.Transparency = 0
.Solid
End With
Else
'sondagem & topografia
If Cells(i - 2, j).Text = "ST" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(112, 48, 160)
.Transparency = 0
.Solid
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 6
End With
Else
End If
'SONDAGEM
If Cells(i - 2, j).Text = "SO" Then
'edita grafico
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 6
End With
Else
End If
'TOPOGRAFIA
If Cells(i - 2, j).Text = "TO" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(112, 48, 160)
.Transparency = 0
.Solid
End With
Else
'Conferência
If Cells(i - 2, j).Text = "COF" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 240)
.Transparency = 0
.Solid
End With
Else
End If
End If
' 6° OPÇÃO
If Cells(i + 1, j + 2).Text = "0" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 255)
.Transparency = 0
.Solid
End With
Else
End If
End If
End If
End If
End If
End If
End If
'mc2
ActiveSheet.Shapes.Range(Array("Retângulo Arredondado 88").Select
Selection.Copy
Cells(i - 2, j).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 52.572440944
Selection.ShapeRange.IncrementTop 33.036062991
If Cells(i - 2, j).Text = "G" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(49, 197, 213)
.Transparency = 0
.Solid
End With
Else
' 2° opção
If Cells(i - 2, j).Text = "L" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(81, 88, 213)
.Transparency = 0
.Solid
End With
Else
'3 opção
If Cells(i - 2, j).Text = "R" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(184, 88, 115)
.Transparency = 0
.Solid
End With
Else
'4° OPÇÃO
If Cells(i - 2, j).Text = "M" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(242, 50, 30)
.Transparency = 0
.Solid
End With
Else
If Cells(i - 2, j).Text = "MI" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 0)
.Transparency = 0
.Solid
End With
Else
'6² OPÇÃO
If Cells(i, j + 2).Text = "" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 255)
.Transparency = 0
.Solid
End With
Else
' 5° OPÇÃO
If Cells(i, j + 2).Text = "MC2" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(46, 205, 9)
.Transparency = 0
.Solid
End With
Else
'sondagem & topografia
If Cells(i - 2, j).Text = "ST" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(112, 48, 160)
.Transparency = 0
.Solid
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 6
End With
Else
End If
'SONDAGEM
If Cells(i - 2, j).Text = "SO" Then
'edita grafico
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 6
End With
Else
End If
'TOPOGRAFIA
If Cells(i - 2, j).Text = "TO" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(112, 48, 160)
.Transparency = 0
.Solid
End With
Else
'Conferência
If Cells(i - 2, j).Text = "cof" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 240)
.Transparency = 0
.Solid
End With
Else
End If
End If
' 6° OPÇÃO
If Cells(i + 1, j + 140).Text = "0" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 255)
.Transparency = 0
.Solid
End With
Else
End If
End If
End If
End If
End If
End If
End If
End If
End If
'Caso a torre já esteja montada
Else
End If
' pendência de projeto
If Cells(i + 1, j + 1).Text = "pp" Then
ActiveSheet.Shapes.Range(Array("Fluxograma: Somador 4").Select
Selection.Copy
Cells(i - 2, j).Select
ActiveSheet.Paste
Else
' Embargo sítio arqueológico
If Cells(i + 1, j + 1).Text = "s" Then
ActiveSheet.Shapes.Range(Array("Fluxograma: Somador 5").Select
Selection.Copy
Cells(i - 2, j).Select
ActiveSheet.Paste
Else
' Embargo proprietário
If Cells(i + 1, j + 1).Text = "p" Then
ActiveSheet.Shapes.Range(Array("Fluxograma: Somador 9").Select
Selection.Copy
Cells(i - 2, j).Select
ActiveSheet.Paste
End If
End If
End If
Else
' Caso torre seja autoportante os dados serão implantado em uma forma quadrada
'revisão
If Cells(i - 2, j + 1).Text = "R" Then
ActiveSheet.Shapes.Range(Array("Object 10").Select
Selection.Copy
Cells(i - 2, j).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
PULAR = OK
Else
'montagem
If Cells(i - 2, j + 1).Text = "M" Then
ActiveSheet.Shapes.Range(Array("Object 9").Select
Selection.Copy
Cells(i - 2, j).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
PULAR = "OK"
Else
PULAR = "NOK"
'montagem incompleta
If Cells(i - 2, j + 1).Text = "MI" Then
ActiveSheet.Shapes.Range(Array("Object 12").Select
Selection.Copy
Cells(i - 2, j).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
Selection.ShapeRange.IncrementTop -1.8750393701
PULAR = "OK"
Else
PULAR = "NOK"
End If
End If
End If
'grampeação
If j > 3 Then
If Cells(i - 2, j - 3).Text = "G" Then
ActiveSheet.Shapes.Range(Array("Freeform 127").Select
Selection.Copy
Cells(i - 2, j - 3).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Else
End If
Else
End If
'EHS vão vante
If j > 3 Then
If j = 53 Then
If Cells(i - 2, j + 3) = "" And Cells(i + 2, j - 50).Text = "G" Then
ActiveSheet.Shapes.Range(Array("Freeform 127").Select
Selection.Copy
Cells(i - 2, j - 3).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Else
End If
Else
End If
Else
End If
'lançamento
If j > 3 Then
If j > 3 And Cells(i - 1, j - 3).Text = "L" Then
ActiveSheet.Shapes.Range(Array("Freeform 128").Select
Selection.Copy
Cells(i - 2, j - 3).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Else
End If
Else
End If
'lançamento OPGW
If j > 3 Then
If Cells(i - 1, j - 2).Text = "OPGW-L" Then
ActiveSheet.Shapes.Range(Array("Freeform 190").Select
Selection.Copy
Cells(i - 2, j - 3).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementLeft 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementTop 1.8750393701
Selection.ShapeRange.IncrementLeft -1.8750393701
Else
End If
Else
End If
'F1
If Cells(i, j + 130).Text = "3" Then
ActiveSheet.Shapes.Range(Array("Imagem 1688").Select
Selection.Copy
Cells(i, j).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Else
End If
'F2
If Cells(i, j + 130).Text = "4" Then
ActiveSheet.Shapes.Range(Array("Imagem 1689").Select
Selection.Copy
Cells(i, j).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Else
End If
' pré montagem
If Cells(i - 2, j + 1).Text <> "R" And Cells(i - 2, j + 1).Text <> "M" And Cells(i - 2, j + 1).Text <> "MI" Then
If Cells(i, j + 128).Text = "1" Then
ActiveSheet.Shapes.Range(Array("Picture 77").Select
Selection.Copy
Cells(i, j).Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Selection.ShapeRange.IncrementTop 1.0914173228
Range("Y73".Select
End If
End If
If PULAR = "NOK" Then
ActiveSheet.Shapes.Range(Array("Rounded Rectangle 239").Select
Selection.Copy
Cells(i - 2, j).Select
DesprotegerPlanilha
ActiveSheet.Paste
' 1° quadrante
' 5° OPÇÃO
If Cells(i - 2, j).Text = "F" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(46, 205, 9)
.Transparency = 0
.Solid
End With
Else
'6² OPÇÃO
If Cells(i - 2, j).Text = "P" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(147, 119, 103)
.Transparency = 0
.Solid
End With
Else
' 6° OPÇÃO
If Cells(i - 2, j).Text = "0" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 255)
.Transparency = 0
.Solid
End With
Else
'sondagem & topografia
If Cells(i - 2, j).Text = "ST" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(112, 48, 160)
.Transparency = 0
.Solid
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 6
End With
Else
End If
'SONDAGEM
If Cells(i - 2, j).Text = "SO" Then
'edita grafico
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 6
End With
Else
End If
'TOPOGRAFIA
If Cells(i - 2, j).Text = "TO" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(112, 48, 160)
.Transparency = 0
.Solid
End With
Else
'Conferência
If Cells(i - 2, j).Text = "COF" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 240)
.Transparency = 0
.Solid
End With
Else
End If
End If
End If
End If
End If
'
' Inicio do 2° quadrante
'
j = j + 1
ActiveSheet.Shapes.Range(Array("Rounded Rectangle 240").Select
Selection.Copy
Cells(i - 2, j).Select
ActiveSheet.Paste
'5² OPÇÃO
If Cells(i - 2, j).Text = "F" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(46, 205, 9)
.Transparency = 0
.Solid
End With
Else
'6² OPÇÃO
If Cells(i - 2, j).Text = "P" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(147, 119, 103)
.Transparency = 0
.Solid
End With
Else
'5² OPÇÃO
If Cells(i - 2, j).Text = "0" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 255)
.Transparency = 0
.Solid
End With
Else
'6² OPÇÃO
If Cells(i - 2, j).Text = "MI" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 0)
.Transparency = 0
.Solid
End With
Else
'sondagem & topografia
If Cells(i - 2, j).Text = "ST" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(112, 48, 160)
.Transparency = 0
.Solid
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 6
End With
Else
End If
'SONDAGEM
If Cells(i - 2, j).Text = "SO" Then
'edita grafico
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 6
End With
Else
End If
'TOPOGRAFIA
If Cells(i - 2, j).Text = "TO" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(112, 48, 160)
.Transparency = 0
.Solid
End With
Else
'Conferência
If Cells(i - 2, j).Text = "COF" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 240)
.Transparency = 0
.Solid
End With
Else
End If
End If
End If
End If
End If
End If
j = j - 1
ActiveSheet.Shapes.Range(Array("Rounded Rectangle 241").Select
Selection.Copy
Cells(i - 1, j).Select
ActiveSheet.Paste
'
' Inicio do 3° quadrante
'
'5 opção
If Cells(i - 1, j).Text = "F" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(46, 205, 9)
.Transparency = 0
.Solid
End With
Else
'6² OPÇÃO
If Cells(i - 1, j).Text = "P" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(147, 119, 103)
.Transparency = 0
.Solid
End With
Else
'6 opção
If Cells(i - 1, j).Text = "0" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 255)
.Transparency = 0
.Solid
End With
Else
'7 opção
'sondagem & topografia
If Cells(i - 2, j).Text = "ST" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(112, 48, 160)
.Transparency = 0
.Solid
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 6
End With
Else
End If
'SONDAGEM
If Cells(i - 2, j).Text = "SO" Then
'edita grafico
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 6
End With
Else
End If
'TOPOGRAFIA
If Cells(i - 2, j).Text = "TO" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(112, 48, 160)
.Transparency = 0
.Solid
End With
Else
'Conferência
If Cells(i - 2, j).Text = "COF" Then
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 240)
.Transparency = 0
.Solid
End With
Else
End If
End If
End If
End If
End If
j = j + 1
ActiveSheet.Shapes.Range(Array("Rounded Rectangle 242").Select
Selection.Copy
Cells(i - 1, j).Select
ActiveSheet.Paste
'
' Inicio do 4° quadrante
'
'5 opção
If Cells(i - 1, j).Text = "F" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(46, 205, 9)
.Transparency = 0
.Solid
End With
Else
'6² OPÇÃO
If Cells(i - 1, j).Text = "P" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(147, 119, 103)
.Transparency = 0
.Solid
End With
Else
If Cells(i - 1, j).Text = "0" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 255)
.Transparency = 0
.Solid
End With
Else
'sondagem & topografia
If Cells(i - 2, j).Text = "ST" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(112, 48, 160)
.Transparency = 0
.Solid
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 6
End With
Else
End If
'SONDAGEM
If Cells(i - 2, j).Text = "SO" Then
'edita grafico
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent6
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.25
.Transparency = 0
End With
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 6
End With
Else
End If
'TOPOGRAFIA
If Cells(i - 2, j).Text = "TO" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(112, 48, 160)
.Transparency = 0
.Solid
End With
Else
'Conferência
If Cells(i - 2, j).Text = "COF" Then
'edita grafico
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 176, 240)
.Transparency = 0
.Solid
End With
Else
End If
End If
End If
End If
End If
j = j - 1
'caso a torre já estejá montada
Else
End If
Cells(i, j).Select
' pendência de projeto
If Cells(i + 1, j + 1).Text = "pp" Then
ActiveSheet.Shapes.Range(Array("Fluxograma: Somador 4").Select
Selection.Copy
Cells(i - 2, j).Select
ActiveSheet.Paste
Else
' Embargo sítio arqueológico
If Cells(i + 1, j + 1).Text = "s" Then
ActiveSheet.Shapes.Range(Array("Fluxograma: Somador 5").Select
Selection.Copy
Cells(i - 2, j).Select
ActiveSheet.Paste
Else
' Embargo proprietário
If Cells(i + 1, j + 1).Text = "p" Then
ActiveSheet.Shapes.Range(Array("Fluxograma: Somador 9").Select
Selection.Copy
Cells(i - 2, j).Select
ActiveSheet.Paste
End If
Cells(i + 1, j + 1).Select
End If
End If
End If
j = j + 3
Wend
i = i + 4
Cells(i, j).Select
j = 3
counter1 = counter1 - 1
Loop
TE: 'Tratar erro
End Sub
0
Identificar item de acordo com parâmetro
Olá amigos!
Estou com dificuldade numa fórmula pra identificar itens de acordo com parâmetro estabelecido. Na planilha em anexo, a coluna C diz respeito a área que um material codificado está inserido na guia ESTOQUE-LIVRE coluna A (deposito).
Tentei usar PROCV porém se um mesmo material estiver em dois depósitos, a fórmula puxa apenas o primeiro item e o restante é desconsiderado. Gostaria poder diferenciar itens exclusivos para cada depósito e caso, no caso em específico CD. Tentei usar SE junto com PROCV, mas não consegui ter um resultado.
Se alguém puder me ajudar, fico grato.
Estou com dificuldade numa fórmula pra identificar itens de acordo com parâmetro estabelecido. Na planilha em anexo, a coluna C diz respeito a área que um material codificado está inserido na guia ESTOQUE-LIVRE coluna A (deposito).
Tentei usar PROCV porém se um mesmo material estiver em dois depósitos, a fórmula puxa apenas o primeiro item e o restante é desconsiderado. Gostaria poder diferenciar itens exclusivos para cada depósito e caso, no caso em específico CD. Tentei usar SE junto com PROCV, mas não consegui ter um resultado.
Se alguém puder me ajudar, fico grato.
0
Tabela Dinâmica com duas datas
0
Carregar dados da base Access x Excel?
0
Excel - Comparar dados de 14 cidades para obter C (Comunidade) ou O (Outsider)
Boas,
Há muito tempo longe daqui, mas agora venho ver se alguém pode dar uma ajuda.
Tenho uma planilha Excel, onde tenho que colocar o nome de cidades, se o nome pertencer a uma lista de 14 cidades, deve dar noutra coluna a informação "C", caso o nome da cidade não esteja incluída na lista das 14, deverá dar "O".
Sei que é possível fazer com SE, mas aninhar 14 SEs não é fácil, eu pretendia outro modo mais prático.
Anexo exemplo da planilha
Agradeço desde já a ajuda que possam dar.
Há muito tempo longe daqui, mas agora venho ver se alguém pode dar uma ajuda.
Tenho uma planilha Excel, onde tenho que colocar o nome de cidades, se o nome pertencer a uma lista de 14 cidades, deve dar noutra coluna a informação "C", caso o nome da cidade não esteja incluída na lista das 14, deverá dar "O".
Sei que é possível fazer com SE, mas aninhar 14 SEs não é fácil, eu pretendia outro modo mais prático.
Anexo exemplo da planilha
Agradeço desde já a ajuda que possam dar.
0
Fórmula para mostra quantidade de vezes que um número se repete
Bom dia!
Qual formula posso usar para mostra a quantidade de vezes que um número se repete em uma determinada seleção de células, no caso dessa planilha do B4 ao B19.
Planilha em anexo
Edit.
Com a fórmula =CONT.SE(C4:C18;15) eu consigo isso, mas precisaria fazer uma para cada número em cada linha, teria como fazer uma fórmula só e copiar para as outras células.
Qual formula posso usar para mostra a quantidade de vezes que um número se repete em uma determinada seleção de células, no caso dessa planilha do B4 ao B19.
Planilha em anexo
Edit.
Com a fórmula =CONT.SE(C4:C18;15) eu consigo isso, mas precisaria fazer uma para cada número em cada linha, teria como fazer uma fórmula só e copiar para as outras células.
0
Apresentação travando vídeo no Powerpoint.
Bom dia personal!...
Estou com problema com o powerpoint
Tenho uma apresentação onde inseri um vídeo e um áudio, sendo que o áudio configurei para tocar em 3 slides.
Estou usando dois monitores, sendo um do notebook e o outro um monitor externo. Estou usando a opção extender tela do Windows. Em uma tela fica a apresentação e na outra a tela de apoio do apresentador. Ocorre, entretanto, que necessito clicar na tela do apresentar para mostrar a barra de tarefas e realizar algumas operações como por exemplo ativa e desativar microfone no OBS. Porém, quando clico nesta outra tela, o vídeo da apresentação para de rodar.
Alguém sabe o que está acontecendo?
Estou com problema com o powerpoint
Tenho uma apresentação onde inseri um vídeo e um áudio, sendo que o áudio configurei para tocar em 3 slides.
Estou usando dois monitores, sendo um do notebook e o outro um monitor externo. Estou usando a opção extender tela do Windows. Em uma tela fica a apresentação e na outra a tela de apoio do apresentador. Ocorre, entretanto, que necessito clicar na tela do apresentar para mostrar a barra de tarefas e realizar algumas operações como por exemplo ativa e desativar microfone no OBS. Porém, quando clico nesta outra tela, o vídeo da apresentação para de rodar.
Alguém sabe o que está acontecendo?
0
Problemas com macros no Excel.
"A Microsoft bloqueou a execução de macros porque a origem deste arquivo não é confiável", em alguns computadores aqui da empresa esta dando esse erro com as planilhas no excel. Percebi que todos os computadores que aconteceu isso são com office 2016. Alguem sabe como resolver??
Ja tentei ir na central de confiabilidade e habilitar todas as macros.
Clicar com o botão direito na planilha ir em propriedades e habilitar a opção de segurança para arquivos de outros computadores.
Essas resoluções que acha na internet ja tentei todas e nada da certo.
Alguem sabe o que pode ser?? se alguma configuração na minha rede ou uma atualização do office 2016 em expecifico
Ja tentei ir na central de confiabilidade e habilitar todas as macros.
Clicar com o botão direito na planilha ir em propriedades e habilitar a opção de segurança para arquivos de outros computadores.
Essas resoluções que acha na internet ja tentei todas e nada da certo.
Alguem sabe o que pode ser?? se alguma configuração na minha rede ou uma atualização do office 2016 em expecifico
0
Excel, formatação condicional
Olá, pessoal. Tenho uma planilha que aponta o markup entre preço de venda e custo de alguns produtos. Montei uma formatação condicional para trocar a cor conforme as margens, mas quando é uma garantia, por exemplo (valor de venda igual a zero), desejo que fique de outra forma e não vermelho, preto por exemplo. Como monto essa regra?
0
LibreOffice Calc: Como alterar as datas da planilha automaticamente?
Boa Tarde a todos.
Tenho uma planilha com informações que não precisam altera-la toda necessariamente,
Exemplificando:
Todo dia 1 de cada mês, eu preciso imprimir essa planilha e as datas precisam ser alteradas na célula determinada.
Estou criando cópias e alterando as datas manualmente e posteriormente envio para impressora. Mas isso toma muito tempo e queria algo mais automatizado. Alguem poderia me da uma dica de como eu posso fazer isso?
Tenho uma planilha com informações que não precisam altera-la toda necessariamente,
Exemplificando:
Todo dia 1 de cada mês, eu preciso imprimir essa planilha e as datas precisam ser alteradas na célula determinada.
Estou criando cópias e alterando as datas manualmente e posteriormente envio para impressora. Mas isso toma muito tempo e queria algo mais automatizado. Alguem poderia me da uma dica de como eu posso fazer isso?
0
Macro copia e cola se duas células iguais
Bom dia,
Preciso de uma macro para copiar valores de uma célula para outras células quando outras 2 células forem iguais, passo a explicar o que preciso:
Na folha com o nome Gráfico_SDemand_22, quando o valor da célula D3 for igual ao valor da célula A3 da folha com o nome Targets, copia o valor da célula B27 da folha Gráfico_SDemand_22 e cola na célula D6 da folha Gráfico_SDemand_22.
Na folha com o nome Gráfico_SDemand_22, quando o valor da célula E3 for igual ao valor da célula A3 da folha com o nome Targets, copia o valor da célula B27 da folha Gráfico_SDemand_22 e cola na célula E6 da folha Gráfico_SDemand_22.
e continua a fazer o mesmo até à coluna O inclusive.
Podem ajudar?
Grato antecipadamente
Preciso de uma macro para copiar valores de uma célula para outras células quando outras 2 células forem iguais, passo a explicar o que preciso:
Na folha com o nome Gráfico_SDemand_22, quando o valor da célula D3 for igual ao valor da célula A3 da folha com o nome Targets, copia o valor da célula B27 da folha Gráfico_SDemand_22 e cola na célula D6 da folha Gráfico_SDemand_22.
Na folha com o nome Gráfico_SDemand_22, quando o valor da célula E3 for igual ao valor da célula A3 da folha com o nome Targets, copia o valor da célula B27 da folha Gráfico_SDemand_22 e cola na célula E6 da folha Gráfico_SDemand_22.
e continua a fazer o mesmo até à coluna O inclusive.
Podem ajudar?
Grato antecipadamente
0
Remover dados duplicados
0
Função CORRESP
Boa tarde!
- No intervalo A2:A77 tenho uma lista, que no final, contém links, também no formato texto.
- Na intervalo J2:J25 uma lista com links em forma de texto
- Na célula N2 a seguinte fórmula: =CORRESP(J2;$A$2:$A$77;1)-1
A questão é:
1- Por que ao copiar a fórmula para procurar as outras linhas, retorna todas com o mesmo resultado e errado? Apenas por coincidência, que a segunda linha retorna 75, que é o certo.
Até agora não consegui descobri onde está o erro nessa lógica.
A intenção é criar uma Formatação Condicional, para que cada valor da coluna J encontrado na coluna A, faça o texto em A ficar em vermelho.
Sei que é uma solução banal, mas meus neurônios cansados, não conseguem resolver isso, quem puder ajudar, agradeço.
Segue a planilha em anexo.
EDIT.: Mudei a fórmula para: =CORRESP(I2;$B$2:$B$77;0)-1 que retorna #N/D
EDIT 2.: Com a fórmula: =CORRESP(I13;$B$2:$B$77;0)+1 estando os textos em J2 em diante iguais em A2 em diante, retorna as posições correta, ou seja, em qual linha na coluna A se encontra o texto, mas o problema é que procuro apenas parte do texto.
- No intervalo A2:A77 tenho uma lista, que no final, contém links, também no formato texto.
- Na intervalo J2:J25 uma lista com links em forma de texto
- Na célula N2 a seguinte fórmula: =CORRESP(J2;$A$2:$A$77;1)-1
A questão é:
1- Por que ao copiar a fórmula para procurar as outras linhas, retorna todas com o mesmo resultado e errado? Apenas por coincidência, que a segunda linha retorna 75, que é o certo.
Até agora não consegui descobri onde está o erro nessa lógica.
A intenção é criar uma Formatação Condicional, para que cada valor da coluna J encontrado na coluna A, faça o texto em A ficar em vermelho.
Sei que é uma solução banal, mas meus neurônios cansados, não conseguem resolver isso, quem puder ajudar, agradeço.
Segue a planilha em anexo.
EDIT.: Mudei a fórmula para: =CORRESP(I2;$B$2:$B$77;0)-1 que retorna #N/D
EDIT 2.: Com a fórmula: =CORRESP(I13;$B$2:$B$77;0)+1 estando os textos em J2 em diante iguais em A2 em diante, retorna as posições correta, ou seja, em qual linha na coluna A se encontra o texto, mas o problema é que procuro apenas parte do texto.
0
Condicional cores em nomes com o Excel
bom dia a todos! Poderiam me ajudar, por favor.
Estou fazendo uma escala de pessoal no excel, infelizmente preciso usar o modelo arcaico da empresa, mas queria colocar uma condicional por cores nos nomes dos funcionários (até ai eu sei fazer), mas quanso eu tenho mais de um funcionário no mesmo dia (Ex: Joãozinho + Mariazinha) ai a cor não muda. Não quero mudar a cor da célula, mas sim a cor do nome apenas.
Vocês sabem me dizer como fazer isso?
Estou fazendo uma escala de pessoal no excel, infelizmente preciso usar o modelo arcaico da empresa, mas queria colocar uma condicional por cores nos nomes dos funcionários (até ai eu sei fazer), mas quanso eu tenho mais de um funcionário no mesmo dia (Ex: Joãozinho + Mariazinha) ai a cor não muda. Não quero mudar a cor da célula, mas sim a cor do nome apenas.
Vocês sabem me dizer como fazer isso?
0
Excel...problema com filtro....Resolvido
0
Coverter Slides do PowerPoint pra Html
Boa Tarde a todos!
Gostaria de uma ajuda, queria incluir um slide criado no PowerPoint e incluir ele em um gerador de HTML que achei pra fazer testes.
Mas não achei nada nas pesquisas Internet e nem algum site que faça essa conversão do Slide de PowerPoint pra Html.
No desde já agradeço a atenção de vocês e fico no aguardo da ajuda.
Att:. Gervazio
Esqueci por o HTML aqui:
Ps:. Usei um link só pra ilustrar o banner.
NOVO CODIGO DA POSTIMG ![]()
NOVO CODIGO DA POSTIMG
Welcome.... Click on the Banner above and visit my Test Store.
Bem vindo.... Clique no Banner acima e visite minha Loja Teste.
Gostaria de uma ajuda, queria incluir um slide criado no PowerPoint e incluir ele em um gerador de HTML que achei pra fazer testes.
Mas não achei nada nas pesquisas Internet e nem algum site que faça essa conversão do Slide de PowerPoint pra Html.
No desde já agradeço a atenção de vocês e fico no aguardo da ajuda.
Att:. Gervazio
Esqueci por o HTML aqui:
Ps:. Usei um link só pra ilustrar o banner.
Bem vindo.... Clique no Banner acima e visite minha Loja Teste.
0
VBA Excel.
Olá
Alguem poderia me ajudar
Estou criando um sistema de estoque
Fiz essa Userform para movimentações
Fiz um codigo que ao digitar o cod do Produto, automaticamente ja preenche na descrição
O código usado é esse:
Private Sub caixa_codigo_Change()
caixa_item.Value = Sheets("Controle_Materiais").Range("A:A").Find(CLng(caixa_codigo.Value)).Offset(0, 1).Value
End Sub
Ele funciona muito bem.
Como podem ver no anexo só tenho o cadastro da Luva Multitato.
Entao ao digitar "1" automaticamente na descrição aparece "Luva Multitato"
Porém quando digito "2" aparece o Erro 91.
Eu queria que ao digitar um número que não existe na planilha aparecesse um msg que o item não está cadastrado, que o item não existe, e não ficasse dando esse erro.
Por exemplo se eu tiver 100 produtos cadastrados, e ao estar alimentando minha planilha erro a digitação e colo "101", vai ver que não existe tal Produto e vai dar apenas essa msg.
Desde já agradeço!
Alguem poderia me ajudar
Estou criando um sistema de estoque
Fiz essa Userform para movimentações
Fiz um codigo que ao digitar o cod do Produto, automaticamente ja preenche na descrição
O código usado é esse:
Private Sub caixa_codigo_Change()
caixa_item.Value = Sheets("Controle_Materiais").Range("A:A").Find(CLng(caixa_codigo.Value)).Offset(0, 1).Value
End Sub
Ele funciona muito bem.
Como podem ver no anexo só tenho o cadastro da Luva Multitato.
Entao ao digitar "1" automaticamente na descrição aparece "Luva Multitato"
Porém quando digito "2" aparece o Erro 91.
Eu queria que ao digitar um número que não existe na planilha aparecesse um msg que o item não está cadastrado, que o item não existe, e não ficasse dando esse erro.
Por exemplo se eu tiver 100 produtos cadastrados, e ao estar alimentando minha planilha erro a digitação e colo "101", vai ver que não existe tal Produto e vai dar apenas essa msg.
Desde já agradeço!
