Usuário com melhor resposta
Manuseamento de dados em Listbox.

Pergunta
-
Bom dia aos utilizadores deste forum.
Preciso da vossa ajuda para resolver uma situação na minha aplicação VBA Excell e vou tentar expor a minha dúvida da forma mais clara possível.
Tenho um Listbox que apresenta os dados pelo click num optionbutton e cuja caption vai dar nome ao Commandbutton6.
O botão 6, através do Listindex, vai criar uma imagem numa pasta com nome 1 se o Listbox não contiver dados (Listindex=-1) e se o Listbox apresentar dados, cria arquivos com o nome do ListIndex+1.
O código renomeia um ficheiro e depois coloca na pasta na sequência correta.
O código que se segue, faz o que necessito.
Private Sub CommandButton6_Click() '===================================== Copiar ficheiros e renomear ========== Dim SearchPath As String Dim nomeANT As String, nomeACT As String Dim fso As Object 'Scripting.FileSystemObject Set fso = CreateObject("Scripting.FileSystemObject") Dim oFSO, subPASTA Dim SOURCEfile Dim DESTINATIONfile Dim CICLO, CICLO2 Dim COPIADO, ALTERADO Dim ORIGEM, DESTINO nomeANT = ListBox1.ListIndex + 1 nomeACT = ListBox1.ListIndex + 2 subPASTA = CommandButton6.Caption & "\" Set oFSO = CreateObject("Scripting.FileSystemObject") '--A A rotina copia os itens c/ o nome do Listindex+1 para outra a pasta FOTOS, renomeando os ficheiros '----um nº acima, criando um espaço numérico. SOURCEfile = ThisWorkbook.Path & "\FOTOS\" & subPASTA & nomeANT & ".JPG" DESTINATIONfile = ThisWorkbook.Path & "\FOTOS\" & nomeACT & ".JPG" '========================= ROTINA PARA LISTBOX SEM REGISTOS =========================== If ListBox1.ListIndex < 0 And CheckBox6.Value = True Then If fso.FileExists(ThisWorkbook.Path & "\FOTOS\" & subPASTA & nomeANT + 2 & ".JPG") = False Then MsgBox "A 1ª IMAGEM VAI SER CRIADA." ' Else SOURCEgeneric = ThisWorkbook.Path & "\FOTOS\" & "A" & ".JPG" '--A rotina copia o último ficheiro da subpasta e renomeia com um nº acima preenchendo o espaço numérico. If fso.FileExists(ThisWorkbook.Path & "\FOTOS\" & subPASTA & nomeANT + 2 & ".JPG") = False Then oFSO.CopyFile SOURCEgeneric, DESTINATIONfile, True End If '-- A rotina copia os arquivos da pasta FOTOS, recolocando-os na Subpasta definitiva e na devida sequência '-------numérica. For CICLO2 = 1 To 1 ORIGEM = ThisWorkbook.Path & "\FOTOS\" & CICLO2 & ".JPG" DESTINO = ThisWorkbook.Path & "\FOTOS\" & subPASTA & CICLO2 & ".JPG" oFSO.MoveFile ORIGEM, DESTINO Next ' Clean Up Set oFSO = Nothing End If MsgBox " ----- 1º FICHEIRO RENOMEADO -----" & vbLf & vbLf _ & " E CRIADO UM NOVO FICHEIRO.", vbInformation, "INFORMAÇÃO" End If '===================== COLOCAR REGISTOS SEGUINTES ========================== If ListBox1.ListIndex >= 1 And CheckBox6.Value = True Then If fso.FileExists(ThisWorkbook.Path & "\FOTOS\" & subPASTA & nomeANT & ".JPG") = False Then MsgBox "A IMAGEM NECESSÁRIA VAI SER CRIADA." Else For CICLO = ListBox1.ListCount To nomeANT Step -1 COPIADO = ThisWorkbook.Path & "\FOTOS\" & subPASTA & CICLO & ".JPG" ALTERADO = ThisWorkbook.Path & "\FOTOS\" & CICLO + 1 & ".JPG" oFSO.MoveFile COPIADO, ALTERADO Next End If SOURCEgeneric = ThisWorkbook.Path & "\FOTOS\" & "A" & ".JPG" DESTfile = ThisWorkbook.Path & "\FOTOS\" & nomeACT - 1 & ".JPG" '--A rotina copia o último ficheiro da subpasta e renomeia com um nº acima preenchendo o espaço numérico. If fso.FileExists(ThisWorkbook.Path & "\FOTOS\" & subPASTA & nomeANT & ".JPG") = False Then oFSO.CopyFile SOURCEgeneric, DESTfile, True End If '-- A rotina copia os arquivos da pasta FOTOS, recolocando-os na Subpasta definitiva e na devida sequência '-------numérica. For CICLO2 = nomeACT + 1 To ListBox1.ListCount - 1 Step -1 ORIGEM = ThisWorkbook.Path & "\FOTOS\" & CICLO2 & ".JPG" DESTINO = ThisWorkbook.Path & "\FOTOS\" & subPASTA & CICLO2 & ".JPG" oFSO.MoveFile ORIGEM, DESTINO Next ' Clean Up Set oFSO = Nothing MsgBox " ----- FICHEIROS RENOMEADOS -----" & vbLf & vbLf _ & " E CRIADO UM NOVO FICHEIRO.", vbInformation, "INFORMAÇÃO" End If
A minha dificuldade prende-se com o facto de necessitar de renomear o último arquivo e atribuir-lhe o nome do Listindex+2.
Se a pasta tiver os ficheiros 1,2,3,4 e 5 e selecionar item 2 do Listbox é gerado o novo arquivo 2 e os restantes são renomeados 1 número à frente. Mas se selecionar o item 5, o último da Caixa de Listagem, preciso que me crie o arquivo 6 e a rotina acima cria-me o arquivo 5 renomeando o 5 para 6.
Penso ter exposto a minha dúvida com suficiente clareza.
Antecipadamente grato pela ajuda que puderem facultar.
Cumprimentos
Manuel António
M_A_S_L
- Editado M_A_S_L sábado, 13 de janeiro de 2018 00:16
Respostas
-
Bom dia Anderson.
Obrigado pela resposta.
Não pode ser feito dessa forma pelos seguintes motivos:
1º-Após criada a imagem, é pedida a inserção de dados que serão gravados numa folha Excell e têm que ser exibidos na ordem correta das imagens de modo que estas serão mostradas em sintonia com o item do listbox selecionado.
2º-A inserção das imagens pretende refletir a inserção de dados de forma alfabética.
Portanto, se a pasta tiver 7 arquivos de imagem, a proxima imagem a inserir pode ser tanto a posição 6 como a posição 8 dependendo do alfabeto.
O aspeto do Userform é este:
Trata-se de moedas, e se eu quiser inserir uma moeda de Portugal, então deverá assumir a última posição na Folha de registo. No entanto se inserir uma da Bélgica deverá assumir a posição 7 e o anterior arquivo 7 é renomeado para 8.
Portanto o código do botão "2018" tem que interagir na perfeição com o código do botão "INSERIR CC".
Será que consegui clarificar o problema?
M_A_S_L
- Marcado como Resposta M_A_S_L domingo, 14 de janeiro de 2018 16:25
-
Amigos, problema resolvido, embora não da forma que pretendia.
Pensei numa caixa de mensagens com introdução de texto, mas optei pela MsgBox tipo Yes/No por serem necessárias menos linhas de código.
Se sim coloca aqui, se não coloca ali.
Obrigado de qualquer forma a quem se esforçou por ajudar.
Cumprimentos
M_A_S_L
- Marcado como Resposta M_A_S_L domingo, 14 de janeiro de 2018 16:22
Todas as Respostas
-
Crie a seguinte condição:
Se o ListIndex for menor que 4 então
Faça do jeito que você está fazendo
Senão
Apenas crie o arquivo 6 sem renomear os outros
Fim Se
A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com
-
Bom dia Anderson.
Obrigado pela resposta.
Não pode ser feito dessa forma pelos seguintes motivos:
1º-Após criada a imagem, é pedida a inserção de dados que serão gravados numa folha Excell e têm que ser exibidos na ordem correta das imagens de modo que estas serão mostradas em sintonia com o item do listbox selecionado.
2º-A inserção das imagens pretende refletir a inserção de dados de forma alfabética.
Portanto, se a pasta tiver 7 arquivos de imagem, a proxima imagem a inserir pode ser tanto a posição 6 como a posição 8 dependendo do alfabeto.
O aspeto do Userform é este:
Trata-se de moedas, e se eu quiser inserir uma moeda de Portugal, então deverá assumir a última posição na Folha de registo. No entanto se inserir uma da Bélgica deverá assumir a posição 7 e o anterior arquivo 7 é renomeado para 8.
Portanto o código do botão "2018" tem que interagir na perfeição com o código do botão "INSERIR CC".
Será que consegui clarificar o problema?
M_A_S_L
- Marcado como Resposta M_A_S_L domingo, 14 de janeiro de 2018 16:25
-
-
-
Boa noite Anderson.
Relativamente à sua primeira sugestão, não dá para criar esse tipo de condição porque teria que ser um nº elevado de condições pois, seria obrigado a criar condições para Espanha , França, Eslováquia, Malta, Itália, Holanda, Irlanda, Luxemburgo, Finlândia, Grécia, Mónaco, S. Marino, Vaticano, Letónia, Lituânia e Estónia. Eventualmente mais algumas dependendo do primeiro registo.
Como tal, pelo menos provisóriamente, optei por fazer o seguinte:
Após o registo do 1º item, os dados serão registados segundo um Listindex + 2. Marcando o 1º Item no Listbox (Listindex=0), será registado o Item 2 como com o Listindex-1 regista o Item 1.
O problema que tinha na ultima posição vai passar para a primeira e vou tentar jogar também com os ficheiros ... se existirem ou não ... fazer isto ou aquilo.
Por agora no entanto está a rolar bem e a fazer registos nos sítios corretos e a criar as imagens nas posições certas, renomeando os ficheiros de acordo com o esperado.
Obrigado no entanto pelas sugestões.
M_A_S_L
- Editado M_A_S_L domingo, 14 de janeiro de 2018 16:24
-
Amigos, problema resolvido, embora não da forma que pretendia.
Pensei numa caixa de mensagens com introdução de texto, mas optei pela MsgBox tipo Yes/No por serem necessárias menos linhas de código.
Se sim coloca aqui, se não coloca ali.
Obrigado de qualquer forma a quem se esforçou por ajudar.
Cumprimentos
M_A_S_L
- Marcado como Resposta M_A_S_L domingo, 14 de janeiro de 2018 16:22