Usuário com melhor resposta
Erro em loop

Pergunta
-
Sou novo em nesse assunto de vba, e comecei a criar uma planilha que faz o seguinte
Copia a aba modelo e cria uma nova planilha
Com a aba criada ela renomeia a mesma a partir de um código na aba resumo
Apos criada e renomeada eu gostaria que a planilha inserisse algumas imagens nela a partir de um diretório de acordo com a numeração das fotos e que elas fossem colocadas em linhas pre determinadas e com o tamanho das imagens também pré determinadas.
Como seriam várias abas a ser criada (seria uma para cada linha preenchida) eu tentei fazer um loop, que funciona quando ele cria a primeira planilha, e quando ele vai colar as imagens na segunda planilha ele da um erro e não sei como resolver isso.
Se alguem puder ajudar seria eternamente grato!!!!
a planilha em questão seria essa
http://www.4shared.com/file/Cug3NSTY/Cpia_de_PR-DM-501-REV0_Macro.html
Respostas
-
Uma das razões de você obter erro é não estar utilizando a declaração Option Explicit. A variável mypath1, que possuía um determinado valor, aparecia como mypath em seguida, retornando um cadeia de texto nula. Declare suas variáveis sempre: http://www.ambienteoffice.com.br/officevba/declaracao_de_variavel/
Reescrevi seu código:
Sub Exemplo() Dim pic As Picture Dim lRow As Long Dim lLast As Long Dim wsResumo As Worksheet Dim wsModelo As Worksheet Dim ws As Worksheet Dim vPic As Variant Dim rng As Range Set wsResumo = ThisWorkbook.Sheets("Resumo") Set wsModelo = ThisWorkbook.Sheets("Modelo") lLast = wsResumo.Cells(wsResumo.Rows.Count, "AB").End(xlUp).Row 'Dados começam a partir da linha 10: For lRow = 10 To lLast wsModelo.Range("P4") = wsResumo.Cells(lRow, "B") wsModelo.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) Set ws = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 'Renomeia o nome da Planilha de acordo com os 3 últimos dígitos da Planilha: ws.Name = CStr(Right(wsModelo.Cells(4, "P"), 3)) With ws For Each vPic In Array( _ .Range("B35"), _ .Range("K35"), _ .Range("B50"), _ .Range("K50"), _ .Range("B65"), _ .Range("K65")) Set rng = vPic Set pic = .Pictures.Insert(rng.Value) pic.Top = rng.Top pic.Left = rng.Left pic.ShapeRange.LockAspectRatio = msoFalse pic.Height = rng.MergeArea.Height pic.Width = rng.MergeArea.Width Next vPic End With Next lRow End Sub
Não se esqueça de apagar a Planilha 001 antes de executar essa rotina.
Observações:
-O VBA não precisa selecionar uma Planilha para trabalhar nela.
-É possível obter o número da última linha preenchida numa coluna e fazer um laço de uma linha até o valor dessa última linha, como está no código.
-O laço dentro do laço que fiz foi para poupar código: ao invés de escrever 6 comandos para inserir e formatar uma imagem, fiz apenas um, dentro de um laço. Como esse laço é numa Variant, o elemento que itera deve ser uma Variant também. Atribuí rng à esse elemento iterador para obter o intellisense para escrever o resto do código.
Felipe Costa Gualberto - http://www.ambienteoffice.com.br
- Editado Felipe Costa GualbertoMVP, Moderator terça-feira, 3 de julho de 2012 22:45
- Marcado como Resposta Hezequias VasconcelosModerator sexta-feira, 16 de novembro de 2012 11:12
Todas as Respostas
-
Uma das razões de você obter erro é não estar utilizando a declaração Option Explicit. A variável mypath1, que possuía um determinado valor, aparecia como mypath em seguida, retornando um cadeia de texto nula. Declare suas variáveis sempre: http://www.ambienteoffice.com.br/officevba/declaracao_de_variavel/
Reescrevi seu código:
Sub Exemplo() Dim pic As Picture Dim lRow As Long Dim lLast As Long Dim wsResumo As Worksheet Dim wsModelo As Worksheet Dim ws As Worksheet Dim vPic As Variant Dim rng As Range Set wsResumo = ThisWorkbook.Sheets("Resumo") Set wsModelo = ThisWorkbook.Sheets("Modelo") lLast = wsResumo.Cells(wsResumo.Rows.Count, "AB").End(xlUp).Row 'Dados começam a partir da linha 10: For lRow = 10 To lLast wsModelo.Range("P4") = wsResumo.Cells(lRow, "B") wsModelo.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) Set ws = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 'Renomeia o nome da Planilha de acordo com os 3 últimos dígitos da Planilha: ws.Name = CStr(Right(wsModelo.Cells(4, "P"), 3)) With ws For Each vPic In Array( _ .Range("B35"), _ .Range("K35"), _ .Range("B50"), _ .Range("K50"), _ .Range("B65"), _ .Range("K65")) Set rng = vPic Set pic = .Pictures.Insert(rng.Value) pic.Top = rng.Top pic.Left = rng.Left pic.ShapeRange.LockAspectRatio = msoFalse pic.Height = rng.MergeArea.Height pic.Width = rng.MergeArea.Width Next vPic End With Next lRow End Sub
Não se esqueça de apagar a Planilha 001 antes de executar essa rotina.
Observações:
-O VBA não precisa selecionar uma Planilha para trabalhar nela.
-É possível obter o número da última linha preenchida numa coluna e fazer um laço de uma linha até o valor dessa última linha, como está no código.
-O laço dentro do laço que fiz foi para poupar código: ao invés de escrever 6 comandos para inserir e formatar uma imagem, fiz apenas um, dentro de um laço. Como esse laço é numa Variant, o elemento que itera deve ser uma Variant também. Atribuí rng à esse elemento iterador para obter o intellisense para escrever o resto do código.
Felipe Costa Gualberto - http://www.ambienteoffice.com.br
- Editado Felipe Costa GualbertoMVP, Moderator terça-feira, 3 de julho de 2012 22:45
- Marcado como Resposta Hezequias VasconcelosModerator sexta-feira, 16 de novembro de 2012 11:12
-
Valeu pela ajuda cara!!!
como eu disse que sou meio novato nesses códigos , estou começando a estudar agora vba e ai não manjo muito dos comandos. A única linguagem que eu tinha uma noção era pascal que eu tive 6 meses de uma matéria na faculdade.
Eu até tinha conseguido fazer o código que eu fiz funcionar, fazendo as variáveis mypath se referenciar com o texto da planilha "modelo" e não mais com a planilha resumo. (acho que é o que você fez aqui também)
Eu adicionei um comando (IF) nessa que você fez e deu certo, que seria para o caso de existir menos fotos do que as 6 que seriam inseridas. Não sei se é a melhor alternativa mas deu certo!!!
E parabéns pelo seu site, era de algo assim que eu precisava pra começar a estudar mesmo, o conteúdo que eu vi la ta muito bem explicado, fácil de entender para quem não manja muito do assunto.
Sub Exemplo() Dim pic As Picture Dim lRow As Long Dim lLast As Long Dim wsResumo As Worksheet Dim wsModelo As Worksheet Dim ws As Worksheet Dim vPic As Variant Dim rng As Range Set wsResumo = ThisWorkbook.Sheets("Resumo") Set wsModelo = ThisWorkbook.Sheets("Modelo") lLast = wsResumo.Cells(wsResumo.Rows.Count, "AB").End(xlUp).Row 'Dados começam a partir da linha 10: For lRow = 10 To lLast wsModelo.Range("P4") = wsResumo.Cells(lRow, "B") wsModelo.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) Set ws = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 'Renomeia o nome da Planilha de acordo com os 3 últimos dígitos da Planilha: ws.Name = CStr(Right(wsModelo.Cells(4, "P"), 3)) With ws For Each vPic In Array( _ .Range("B35"), _ .Range("K35"), _ .Range("B50"), _ .Range("K50"), _ .Range("B65"), _ .Range("K65")) Set rng = vPic If vPic = "" Then Else Set pic = .Pictures.Insert(rng.Value) pic.Top = rng.Top pic.Left = rng.Left pic.ShapeRange.LockAspectRatio = msoFalse pic.Height = rng.MergeArea.Height pic.Width = rng.MergeArea.Width End If Next vPic End With Next lRow End Sub
-