Erro em loop

Question

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

 

Answer 1

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

Answer 2

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

Answer 3

Obrigado pela visita ao site.

Você usou o If da forma correta.

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br