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
Manuseamento de dados em Listbox.
