Suíte Office:Tópico Oficial Dicas de Excel
__________________________________________
Envie MP para sugerir tópicos para esta seção.
__________________________________________
1
- 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
Excel
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
Excel, como aumentar a linha e a coluna?
lulaca disse:fiz o que vc falou de mesclar as células ´so que o texto é grande e não aparece ele todo, isso vai ser visto em data show por isso a célula deve estar visivel com todo o texto.
exemplo pegue esse texto e faça ele fica visivel tanto em linhas como coluna?
DEMETRIUS DE ALMEIDA PIRES.
Permita-me contrapor alguns pontos de vistas do que o amigo apresentou...
Não existe e nem vai existir qualquer programa que compacte um DVD, em média 6.5 Gb para 4.7 Gb, sem perder qualidade... seja ele qual for, o tempo que for, as passagens que der... sempre se perderá qualidade... é inevitável... senão poderiamos esperar no futuro um compactador que transformasse 6.5 GB em apenas um byte com a qualidade de cinema...
O Rebuilder, o DVD2SVCD, e tantos outros, utilizando o CCE ou equivalente, vai demorar horas nessa conversão e no final o resultado é aproximadamente igual, pouco melhor ou pouco pior... para se notar a diferença vc teria que utilizar equipamentos de precisão, pois a nossa visão e audição não vai detetar essas pequenas diferenças...
O problema do Shrink é que ele é freeware... e quando as coisas são grátis, todo santo desconfia de sua eficiência... se vc compactar o MENU, MAIN e EXTRA a 50%, vc notará alguma diferença se for assistir em tela grande, com algum projetor... em TV até 29" não dá para notar muita diferença... o pior DVD que compactei foi o da IVETE SANGALO... não cortei o EXTRA porque ele é um segundo show... e no próprio DVD original, a imagem do EXTRA já é sofrível... assistindo em uma TV de 34", eu notei alguma perda de qualidade colando os olhos na tela da TV, pois foi compactado próximo aos 50%... o DVD original tem 8.2 Gb, maior do que o senhor dos anéis... mas nada que incomode se assitido a uma distância adequada...
Sou defensor do Shrink porque ele oferece todos os recursos necessários para copiar um DVD, é rápido, é fácil de usar, é freeware, é popular e apresenta ótimos resultados...
O RB apresenta um ótimo resultado também, tem mais recursos, é pago, é complicado de se usar e gasta horas pra fazer o mesmo trabalho que o Shrink faz em 1/2 hora...
No final, a diferença de imagem/som, se existir, é desprezível e poderá ser pior ou melhor... será que vale a pena gastar horas a fio nesse tipo de compactação ??? Penso que não...
Além do que, embora eu não utilize, o Shrink tem um tal de EAC... dependendo de como vc setar o EAC, a compactação será feita em mais de uma passagem, demorando mais tempo e melhorando a qualidade do produto final (dizem)... eu não utilizo porque tanto o EAC como o RB deixam a imagem um pouco borrada, sob o minha ótica, perdendo a definição... isso é devido a eliminação de detalhes para tornar cada frame mais enxuto, com menor número de bytes...
Finalmente, quem quer copiar vários DVD por dia, terá que ter alguns micros dedicados para trabalhar com o RB... com o Shrink é vapt-vupt...
Bem, são os meus pontos de vista, não necessariamente perfeitos...
Estou com o mesmo problema hoje (abr 2024). É a altura máxima da linha. Estou tendo que excluir linhas em branco dentro do texto - aí o texto fica todo espremido. É o jeito. #ódio
Teria que mesclar com outra linha abaixo, mas daí, vai bagunçar os filtros e outros recursos da planilha. #ódiodenovo
Nem alargar a coluna resolve, pq o problema é número de linhas mesmo. #ódiodessebill
0
Função CONT.SES
Boa noite a todos,
Tenho andado sumido do fócum, agora, necessito da ajuda da comunidade. Em anexo está a planilha. Eu preciso contar com dois critérios, mas, um critério está nas linhas e outro em uma coluna.
Tentei utilizar a função CONt.SES com a função Soma, mas não deu...
Agradeço a quem puder ajudar.
Tenho andado sumido do fócum, agora, necessito da ajuda da comunidade. Em anexo está a planilha. Eu preciso contar com dois critérios, mas, um critério está nas linhas e outro em uma coluna.
Tentei utilizar a função CONt.SES com a função Soma, mas não deu...
Agradeço a quem puder ajudar.
0
Ajuda com fórmula do Excel.
0
Excel, como verificar uma sequência de números?
Olááá! Preciso de uma luz para facilitar meu dia a dia... em uma coluna do Excel tenho uma sequência longa de números, que devem estar completos, ou seja, se começar no 100 e terminar em 200, preciso ter certeza que todos os números do intervalo estejam aí no meio. Não adianta criar uma regra de pegar o último, diminuir do primeiro e verificar se o número de células bate, pois os números podem ser repetir (pode haver 2 ou 3 células com o 160, por exemplo), mas não pode faltar nenhum que esteja dentro do intervalo. Tem como? Se sim, por favor, expliquem passo a passo pois sou leiga demais, agradecia! Em anexo, a sequencia que eu preciso saber os números que faltam...mas gostaria de aprender para futuras planilhas
0
Tabela Dinâmica com duas datas
0
Não imprime documento Word, somente cópia colorida do scanner.
0
Arquivos deletados da lixeira do OneDrive
Prezados, boa tarde.
recebi um anúncio de que teria que assinar o Microsoft 365 pois estava extrapolando o OneDrive. Eu utilizo uma conta empresarial para usar os produtos Office, por isso nunca assinei na minha conta pessoal. Imediatamente, apaguei diversas pastas do OneDrive e logo em seguida da lixeira (burro) e elas foram excluídas de TODOS os meus dispositivos (celular, computador). Eu achei que estava excluindo apenas do OneDrive. Assinei o 365 logo em seguida mas a recuperação retorna com as pastas vazias, sem os arquivos. Já pedi auxílio ao suporte, que gerou um número de controle, mas estou sem resposta há uma semana. Ainda estou dentro da janela de 30 dias, será que há chance de recuperação? Grato pela atenção.
recebi um anúncio de que teria que assinar o Microsoft 365 pois estava extrapolando o OneDrive. Eu utilizo uma conta empresarial para usar os produtos Office, por isso nunca assinei na minha conta pessoal. Imediatamente, apaguei diversas pastas do OneDrive e logo em seguida da lixeira (burro) e elas foram excluídas de TODOS os meus dispositivos (celular, computador). Eu achei que estava excluindo apenas do OneDrive. Assinei o 365 logo em seguida mas a recuperação retorna com as pastas vazias, sem os arquivos. Já pedi auxílio ao suporte, que gerou um número de controle, mas estou sem resposta há uma semana. Ainda estou dentro da janela de 30 dias, será que há chance de recuperação? Grato pela atenção.
0
Google Planilhas
Olá, amigos. Tentei fazer a concateção com os critério de A, B e C, mas não consegui. Tenho uma tabela onde nas colunas A, B e C eu tenho os tipos de critérios,
na coluna D eu tenho a situação. A ideia é juntar textos da coluna C (entre vírgulas) dependendo dos critérios das colunas A e B. Exemplo:
segue o link da planilha: https://docs.google.com/spreadsheets/d/132QpWzffjhTnuJQcfOq2EpH_fkOr7uksqM_DGgWgjHY/edit#gid=658516220
Ficaria muito agradecido se alguém puder me ajudar.
Ivan
na coluna D eu tenho a situação. A ideia é juntar textos da coluna C (entre vírgulas) dependendo dos critérios das colunas A e B. Exemplo:
A B C D E
Critério 1 Critério 2 Critério 3 Situação (#1) - (NF34) - (CRIT34) - situação1, situação2, situação3.
#1 NF34 CRIT34 situação1 (#2) - (NF21) - (CRIT87) - situação4, situação5.
#1 NF34 CRIT34 situação2 (#3) - (NF35) - (CRIT63) - situação1, situação2, situação3, situação4.
#1 NF34 CRIT34 situação3 (#4) - (NF27) - (CRIT19) - situação5.
#2 NF21 CRIT87 situação4
#2 NF21 CRIT87 situação5
#3 NF35 CRIT63 situação1
#3 NF35 CRIT63 situação2
#3 NF35 CRIT63 situação3
#3 NF35 CRIT63 situação4
#4 NF27 CRIT19 situação5
Resultado na coluna E
(#1) - (NF34) - (CRIT34) - situação1, situação2, situação3.
(#2) - (NF21) - (CRIT87) - situação4, situação5.
(#3) - (NF35) - (CRIT63) - situação1, situação2, situação3, situação4.
(#4) - (NF27) - (CRIT19) - situação5.
Com 2 critérios o expert Mário Lúcio fez com perfeição
=let(a; byrow(map(A2:A11;B2:B11;lambda(x;y;hstack(concatenar("(";x;""concatenar("(";y;""))); lambda(x; join(" - "; x))); byrow(unique(a); lambda(y; y&" - "&join(", "; filter(C2:C11; a=y)))))
Tentei fazer com 3 e não consegui; Fiz assim:
=let(a; byrow(map(A2:A;B2:B;C2;C;lambda(x;y;z;hstack(CONCATENATE("(";x;""CONCATENATE("(";y;""CONCATENATE("(";z;""))); lambda(x; join(" - "; x))); byrow(unique(a); lambda(y; y&" - "&join(", "; lambda(z; z&" - "&join(", "; filter(C2:C; a=y)))))segue o link da planilha: https://docs.google.com/spreadsheets/d/132QpWzffjhTnuJQcfOq2EpH_fkOr7uksqM_DGgWgjHY/edit#gid=658516220
Ficaria muito agradecido se alguém puder me ajudar.
Ivan
0
Excel: existe sentença mais precisa que 'ProcV'?
Boa tarde a todos, tenho uma planilha que busca valores em outra aba por meio de "ProcV". Percebo que quando uma linha não encontra referência, ela copia o valor da linha acima. Existe alguma forma e deixar a 'procV' exata quanto ao termo que ela deve buscar?
Atualização: 04/03/2024 17:10
Descobri...
=PROCV(A2; $A$2:$C$10; 3; FALSO)
Atualização: 04/03/2024 17:10
Descobri...
=PROCV(A2; $A$2:$C$10; 3; FALSO)
0
Fechar workbook após inatividade
LaerteB disse:Boa tarde, Patricia Mielczarski
Obrigado você ; estamos aqui para ajudar.
Fiquei feliz que resolveu a sua questão .. e também agora sabemos que o erro era
ocasionado pelo formato da imagem (.ico) .
Opa seu Office é da versão de "1908", bem velhinho né rsrsrsrs...
LaerteB
Olá.
este código dá muito jeito e eu já coloquei em uma folha de Excel mas não executa automaticamente. onde estarei a falhar? Obrigado
0
Indexação Outlook
Boa tarde pessoal,
tenho um desktop que está com W11 e Office 2016, a indexação do outlook fica em looping, ela chega a terminar e funciona as pesquisas nos e-mails por 1 dia, no dia seguinte já tenho dificuldades pra pesquisar dentro do outlook, quando reparei a indexação ainda estava indexando 20000 arquivos...
ou seja, nunca termina a indexação.
Já tentei recriar diversas vezes e sempre faz isso.
Alguém pode ajudar?
Obrigado!
tenho um desktop que está com W11 e Office 2016, a indexação do outlook fica em looping, ela chega a terminar e funciona as pesquisas nos e-mails por 1 dia, no dia seguinte já tenho dificuldades pra pesquisar dentro do outlook, quando reparei a indexação ainda estava indexando 20000 arquivos...
ou seja, nunca termina a indexação.
Já tentei recriar diversas vezes e sempre faz isso.
Alguém pode ajudar?
Obrigado!
0
Somar horas descontando sábado e domingo
Prezados, bom dia
Por favor, preciso de ajuda com uma fórmula no google sheets
Tenho uma planilha que possui 6 colunas
coluna 1 = data da solicitação
coluna 2 = hora da solicitação
coluna 3 = descontar hora do almoço
coluna 4 = data início da manutenção
coluna 5 = hora início da manutenção
coluna 6 = tempo de resposta = (data inicio manutenção + hora inicio manunteção) - (data da solicitação + hora da solicitação)
pontos a serem considerados
horário padrão a ser considerado: 7:30 até 17:20 (segunda a quinta, em sexta até as 17:10), não pode contar 24 horas do dia e considerar apenas de segunda a sexta.
exemplo:
data da solicitação: 23/02/2024
hora da solicitação: 8:00
descontar hora do almço : SIM
data ínicio manutenção: 26/02/2024
hora início manutenção: 8:30
tempo de resposta: 9:10
nesse exemplo eu considerei apenas o meu horário de expediente e optei por descontar horário do almoço.
porém eu preciso de uma fórmula para fazer isso
Por favor, preciso de ajuda com uma fórmula no google sheets
Tenho uma planilha que possui 6 colunas
coluna 1 = data da solicitação
coluna 2 = hora da solicitação
coluna 3 = descontar hora do almoço
coluna 4 = data início da manutenção
coluna 5 = hora início da manutenção
coluna 6 = tempo de resposta = (data inicio manutenção + hora inicio manunteção) - (data da solicitação + hora da solicitação)
pontos a serem considerados
horário padrão a ser considerado: 7:30 até 17:20 (segunda a quinta, em sexta até as 17:10), não pode contar 24 horas do dia e considerar apenas de segunda a sexta.
exemplo:
data da solicitação: 23/02/2024
hora da solicitação: 8:00
descontar hora do almço : SIM
data ínicio manutenção: 26/02/2024
hora início manutenção: 8:30
tempo de resposta: 9:10
nesse exemplo eu considerei apenas o meu horário de expediente e optei por descontar horário do almoço.
porém eu preciso de uma fórmula para fazer isso
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
Alteração no código VBA do Excel
Boa tarde!
Efetuei a copia de uma planilha criada por Fabio Mitsueda, para importação de dados de XML de NF-e para o excel.
Precisaria utilizar esta planilha para fazer importação também de XML de NFC-es, mas estou com um problema no código, ocorrem casos de venda de mercadoria pela NFC-e que não é informado o destinatário por ser venda em balcão, então a tag "dest" não é informada, e desta maneira ocorre erro, pois no codigo estava prevista a tag "dest".
Tenho uma experiência pequena com VBA, vocês poderiam me ajudar a alterar o codigo para que funcione a importação também da NFC-e que não existir a tag "dest" no XML, por favor?
segue o arquivo excel com o código.
Muito Obrigado pela atenção!
Efetuei a copia de uma planilha criada por Fabio Mitsueda, para importação de dados de XML de NF-e para o excel.
Precisaria utilizar esta planilha para fazer importação também de XML de NFC-es, mas estou com um problema no código, ocorrem casos de venda de mercadoria pela NFC-e que não é informado o destinatário por ser venda em balcão, então a tag "dest" não é informada, e desta maneira ocorre erro, pois no codigo estava prevista a tag "dest".
Tenho uma experiência pequena com VBA, vocês poderiam me ajudar a alterar o codigo para que funcione a importação também da NFC-e que não existir a tag "dest" no XML, por favor?
segue o arquivo excel com o código.
Muito Obrigado pela atenção!
0
Separar algarismo de um número no excel
Rudney Estud... disse:Boa tarde pessoal,
Preciso separar os algarismos de varios números no excel em colunas ou linhas, utilizei a função =EXT.TEXTO, mas ela retorna somente texto e não consigo converter em número, pois preciso aplicar a função =SOMAQUAD nos alagrismos separados. Alguma ideia?
Desculpem desenterrar...
A formula funciona perfeito com números.
Mas em seguencias alfanuméricas ela deixa a célula vazia (onde deveria ter uma letra).
Alguma dica?!
0
Ajuda Excel - números não estão sendo reconhecidos como valores
Prezados, boa tarde, tudo bem?
Estou tentando fazer com que o Excel reconheça os valores da planilha em anexo como números, porém não consigo de jeito nenhum. Já utilizei a função valor, formatei, verifiquei se a coluna está em formato de texto, criei uma dinâmica para somar os valores, mas não vai. Poderiam me ajudar por favor?
O Excel fica realizando a contagem dos números e nunca a soma.
Obrigado!
Estou tentando fazer com que o Excel reconheça os valores da planilha em anexo como números, porém não consigo de jeito nenhum. Já utilizei a função valor, formatei, verifiquei se a coluna está em formato de texto, criei uma dinâmica para somar os valores, mas não vai. Poderiam me ajudar por favor?
O Excel fica realizando a contagem dos números e nunca a soma.
Obrigado!
0
Selecionar 1 cliente, e Excel/libre office preenche automaticamente outro dado. Misto de autocompletar e lista suspensa
Pessoal, já fiz isso, mas não lembro
Eu tenho uma planilha de clientes:
E tenho uma planilha Geral, onde vou preencher o que preciso. Exemplo
Eu quero que, ao selecionar de uma lista suspensa o nome do cliente, automaticamente o excel/libreoffice preencha o código interno.
Eu lembro que era relativamente fácil, mas não lembro como fazer, sinceramente.
Eu tenho uma planilha de clientes:
| NOME | CÓDIGO INTERNO |
| PEDRO | 11111111111 |
| PRISCILA | 11111111112 |
| CINTIA | 11111111113 |
| MARIA 2 | 11111111114 |
| MARIA 4 | 11111111115 |
| PEDRO PAULO | 11111111116 |
| VIRGINIA | 11111111117 |
| PEDRO | 20011112222 |
| PRISCILA | 20011112223 |
| CINTIA | 20011112224 |
| MARIA 2 | 20011112225 |
| MARIA 4 | 20011112226 |
| PEDRO PAULO | 20011112227 |
| VIRGINIA | 20011112228 |
E tenho uma planilha Geral, onde vou preencher o que preciso. Exemplo
| CLIENTE | MCI | CÓDIGO / BEM | VENDA EM |
| CINTIA | 20011112224 | 525711700 CLIMATIZADOR ELGIN | 2020 |
Eu quero que, ao selecionar de uma lista suspensa o nome do cliente, automaticamente o excel/libreoffice preencha o código interno.
Eu lembro que era relativamente fácil, mas não lembro como fazer, sinceramente.
