Notifications
Clear all

visualizador Imagens FSO Recursiva

77 Posts
4 Usuários
0 Reactions
10.7 K Visualizações
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

Olá colegas!
bom domingo!

deejo fazer um visualizador de Imagens Excel usando FSO (FileSystemObject)
recursiva em todos os codigos.
o primeiro desafio é listar os arquivos ou pastas com subpastas no Listbox.
lembrando sempre usar FSO recursiva.

eu consegu listar a primeira subpasta, mas nao tá puxando as outras.
meu prolema é listar todas as subpastas e os arquivos delas paradamente em um listbox pra cada.
eu configurei pra buscar e (c:teste) e incluí no arquivo de exemplo.
incluí no arquivo excel a tela de como deve ficar no final o visualizador de imagens.
eu tenho um visualizador de SKINS em vb6 que dá pra tirar o codigo mas nao sei como edita-lo.
grato.

 
Postado : 12/07/2015 8:16 am
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

Olá AdGERE!

Essa eu já sabia que tem que colocar dentro do Optionbutton

eu entendi que ao ser clicado o OptionButton irá executar a sub Listar_arquivos do Módulo MóduloPesquisa
mas, não entendi por que a sub inclui "Plan1.txtDiretorio.Value" ?????

eu quero passar esse valor do OptionButton pra uma variavel dentro do VBA, como aquela "BuscarPor"
só depois que vou passar o valor da variavel pra uma celula.

por exemplo:
If OptionButton_JPG = "*jpg" Then BuscarPor = OptionButton.value ---(que é *jpg)

eu acho que esse trecho deve ser colocado na sub Listar_Arquivos, em vez de no OptionButton.
------------------------------------------------------------------------
veja como eu coloquei no OptionButton:

Private Sub optJPG_Click()

Sheets("Arqs").Range("k1").Value = "*.JPG" (este funciona)
MóduloPesquisa.Listar_arquivos optJPG (este nao funciona)

end sub

 
Postado : 17/07/2015 11:29 am
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

Olá Colegas e AdGere!

na --- Function VerifExt(Arq As String) As Boolean, -----
existem varias extensões de arquivo, como o codigo de ---

If md_Pasta.VerifExt(fsoPasta & "" & fsoArquivo.Name) = True Then, ------

vai saber qual a extensão selecionada no option button clickado???
Por que existe : "fsoPasta & "" & fsoArquivo.Name" no codigo acima???
----------------------------------------------------------------------------

por que existe "Plan1.txtDiretorio.Value " ???? no codigo abaixo????
Private Sub optJPG_Click()
MóduloPesquisa.Listar_arquivos Plan1.txtDiretorio.Value
end sub.
-----------------------------------------------------------------------------------
o que desejo é o seguinte:
um campo no vba onde será armazenado o valor do option button clicackado (*.JPG)
cada vez que um optionbutton diferente for clicado campo do vba assume esse novo valor.
por exemplo: se a extensão de um arquivo for igual à extensão (.jpg) selecionada no OptionButton, mostra os arquivos.
se a extensão do arquivo for diferente da extensao selecionada no OptionButton, não mostra essess arquivos.

 
Postado : 17/07/2015 11:58 am
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

eu não sei fazer referencia no VBA ao OptionButton inserido na celula.
se eu soubesse, escreveria um codigo parecido com esse:
If optionBbuttomJPG.value = "*.JPG" then sTRING = optionBbuttomJPG.value

 
Postado : 17/07/2015 12:09 pm
(@adgere)
Posts: 76
Trusted Member
 

XMAN, boa noite...

O optionButton possui apenas 2 valores, Verdadeiro ou Falso..
Portanto, na linha que escreveu:
If optionBbuttomJPG.value = "*.JPG" then sTRING = optionBbuttomJPG.value
Seria:

If OptionButtonJPG.value = true then String = "*.JPG"
If OptionButtonGIF.value = true then String = "*.GIF"

--------------------------------------------------------------

 
Postado : 17/07/2015 5:39 pm
(@adgere)
Posts: 76
Trusted Member
 

na --- Function VerifExt(Arq As String) As Boolean, -----

Perceba que na Função VerifExt solicita uma entrada de uma String.. que é a variavel Arq...

Quando Chamo essa função:

If md_Pasta.VerifExt(fsoPasta & "" & fsoArquivo.Name) = True Then

Preciso informar o valor da Variavel Arq... que no caso "fsoPasta" é a pasta onde o arquivo esta e "fsoArquivo.Name" é o nome do arquivo... então "fsoPasta & "" & fsoArquivo.Name" indica o arquivo a ser verificado a extensão

_________________________________________________

Private Sub optJPG_Click()
MóduloPesquisa.Listar_arquivos Plan1.txtDiretorio.Value
end sub.

A Sub Listar_arquivos também solicita uma variavel

"Sub Listar_arquivos(sPasta As Variant)"

Que é sPasta... entao ao chamar essa Sub.. tenho que dizer em qual diretorio/Pasta ele irá procurar os arquivos e subpastas...

Plan1 = Sheets(Arqs)
txtDiretorio = Ref. à caixa de texto Caminho que esta na Plan1
Value = é o valor que esta dentro desta caixa de texto

 
Postado : 17/07/2015 5:49 pm
(@adgere)
Posts: 76
Trusted Member
 

eu não sei fazer referencia no VBA ao OptionButton inserido na celula.
se eu soubesse, escreveria um codigo parecido com esse:
If optionBbuttomJPG.value = "*.JPG" then sTRING = optionBbuttomJPG.value

Verifique como fiz na Function VerifExt(Arq As String) As Boolean

que ficaria assim

If OptionButtonJPG.value = true then
String = "*.jpg"
end if

Porém se você colocar em um modulo você precisa informar onde esta esse optionButton... que no caso esta na Plan1 ou Sheets("Arqs")... entao o codigo fica assim..

If Plan1.OptionButtonJPG.value = true then
String = "*.jpg"
end if

 
Postado : 17/07/2015 5:54 pm
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

oLÁ aDgERE!!!

voce foi fantastico explicando pra mim.
juro que vou estudar amanha dia e noite com muita calma suas explicações.
só nao garanto que vou entender todas.
eu criei um novo tópico semelhante a este pra tentar incluir num codigo meu FSO, essa filtragem por extensão, de forma mais simples.

Option Button filtra por extensão incluir Listbox
" http://www.planilhando.com.br/forum/viewtopic.php?f=10&t=16655"
viewtopic.php?f=10&t=16655

porque quando as pessoas veem muitas paginas desistem de acompanhar e entender e ajudar.
lá no outro topico eu quero manter o meu codigo de busca de arquivos e implantar o filtro por extensão.
ainda conto com sua ajuda.
grande abraço.

 
Postado : 17/07/2015 6:41 pm
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

O codigo de listar arquivos FSO a ser utilizado é:

Lembrando:
quero que o codigo do OptionButton sirva pra filtrar os arquivos resultantes do seguinte codigo FSO:

-----------------------------------------------------
Sub Sample2()
ShowFolderList2 ("C:teste")
End Sub
-------------------------------------------------------------------------------

Sub ShowFolderList2(folderspec)
Dim fs, f, f1, fc, s, sFldr
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.SubFolders
For Each f1 In fc
If Right(f1, 1) <> "" Then ShowFolderList2 f1 & "" Else ShowFolderList2 f1
Next
Set fc = f.Files
For Each f1 In fc
Debug.Print folderspec & f1.Name

With Worksheets("Visualizador")
Worksheets("Visualizador").ListBox2.AddItem folderspec & f1.Name
End With

 
Postado : 17/07/2015 6:47 pm
(@adgere)
Posts: 76
Trusted Member
 

O codigo de listar arquivos FSO a ser utilizado é:

Lembrando:
quero que o codigo do OptionButton sirva pra filtrar os arquivos resultantes do seguinte codigo FSO:

-----------------------------------------------------
Sub Sample2()
ShowFolderList2 ("C:teste")
End Sub
-------------------------------------------------------------------------------

Sub ShowFolderList2(folderspec)
Dim fs, f, f1, fc, s, sFldr
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.SubFolders
For Each f1 In fc
If Right(f1, 1) <> "" Then ShowFolderList2 f1 & "" Else ShowFolderList2 f1
Next
Set fc = f.Files
For Each f1 In fc
Debug.Print folderspec & f1.Name

With Worksheets("Visualizador")
Worksheets("Visualizador").ListBox2.AddItem folderspec & f1.Name
End With

A Verificação da Extensão você terá que fazer nessa parte do codigo:

For Each f1 In fc
Debug.Print folderspec & f1.Name

With Worksheets("Visualizador")
Worksheets("Visualizador").ListBox2.AddItem folderspec & f1.Name
End With

Seu codigo pode ficar assim

Dim fs, f, f1, fc, s, sFldr
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.SubFolders

For Each f1 In fc
    If Right(f1, 1) <> "" Then ShowFolderList2 f1 & "" Else ShowFolderList2 f1
Next

Set fc = f.Files
For Each f1 In fc
    Debug.Print folderspec & f1.Name

    Select Case UCase(fs.GetExtensionName(folderspec & f1.Name))
           Case "JPG"
                If Worksheets("Visualizador").OptionButtonJPG.Value = True Or _
                   Worksheets("Visualizador").OptionButtonTodos.Value = True Then
                   GoTo Lancar
                Else
                   GoTo Pular
                End If
           Case "GIF"
                If Worksheets("Visualizador").OptionButtonGIF.Value = True Or _
                   Worksheets("Visualizador").OptionButtonTodos.Value = True Then
                   GoTo Lancar
                Else
                   GoTo Pular
                End If
           Case "BMP"
                If Worksheets("Visualizador").OptionButtonBMP.Value = True Or _
                   Worksheets("Visualizador").OptionButtonTodos.Value = True Then
                   GoTo Lancar
                Else
                   GoTo Pular
                End If
           Case Else
                GoTo Pular
    End Select
    
Lancar:
    Worksheets("Visualizador").ListBox2.AddItem folderspec & f1.Name
    
Pular:

Next

End Sub
 
Postado : 17/07/2015 7:15 pm
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

Olá AdGere,
continuo imensamente grato pela sua ajuda.
se vc tiver intresse em fazer parcerias comigo, eu tenho coisas muito interessantes que eu nao domino o suficiente pra fazer funcionar.

vou estudar e testar tudo o que voce postou hoje, amanhã, pois estou cansadíssimo

mas quero aproveitar pra lhe dizer que dá sim pra colocar outro valor no OptionButton que nao true ou false.
vou anexar tambem o arquivo só pra vc entender melhor. Clicke nos OptionButton e repare na mudança na celula "K1",
que assumirá o valor da extensão (bmp, jpg, etc).
veja:
---------------------------------------------------------------------
Private Sub optJPG_Click()

Sheets("Arqs").Range("k1").Value = "*.JPG"
MóduloPesquisa.Listar_arquivos optJPG

End Sub

 
Postado : 17/07/2015 8:29 pm
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

Ola AdGere!
bom dia!

eu tentei implantar os seus ultimos codigos vba acima, mas nao deu certo.
o primeiro eu achei onde colocar, já o segundo não tenho certeza se ficou no lugar certo
está dando o seguinte erro: "Sub ou function nao definida"
eu teria de colocar um nome especifico no nome da Sub?
eu testei com "ShowFolderList2", e com "teste2" e ambos deram erro.
gostaria muito que vc implantasse essas alterações pra mim.
ou me dê uma luz.
gratíssimo.

 
Postado : 17/07/2015 9:59 pm
(@adgere)
Posts: 76
Trusted Member
 

XMAN consegue identificar em qual linha ocorre o erro?

O Codigo que inseri foi como exemplo.. os nomes dos controles e da planilha tem que coincidir com os do codigo.

 
Postado : 17/07/2015 10:03 pm
(@adgere)
Posts: 76
Trusted Member
 

Olá AdGere,
continuo imensamente grato pela sua ajuda.
se vc tiver intresse em fazer parcerias comigo, eu tenho coisas muito interessantes que eu nao domino o suficiente pra fazer funcionar.

vou estudar e testar tudo o que voce postou hoje, amanhã, pois estou cansadíssimo

mas quero aproveitar pra lhe dizer que dá sim pra colocar outro valor no OptionButton que nao true ou false.
vou anexar tambem o arquivo só pra vc entender melhor. Clicke nos OptionButton e repare na mudança na celula "K1",
que assumirá o valor da extensão (bmp, jpg, etc).
veja:
---------------------------------------------------------------------
Private Sub optJPG_Click()

Sheets("Arqs").Range("k1").Value = "*.JPG"
MóduloPesquisa.Listar_arquivos optJPG

End Sub

Na verdade o que aparece na celula K1 não é o valor do OptionButton, mas sim o resultado do codigo que você implementou dentro do evento Click do OptionButton...
Seria o valor do OptionButton se voce colocasse: Sheets("Arqs").Range("k1").Value = OptionButton.Value...

Se você fizer dessa forma.. na celula K1 so poderá aparecer verdadeiro ou falso..

 
Postado : 17/07/2015 10:22 pm
(@adgere)
Posts: 76
Trusted Member
 
Sub Sample2()
        Sheets("Visualizador").ListBox2.Clear
        ShowFolderList2 ("C:teste")
End Sub

Sub ShowFolderList2(folderspec)
Dim fs, f, f1, fc, s, sFldr
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.SubFolders

For Each f1 In fc
    If Right(f1, 1) <> "" Then ShowFolderList2 f1 & "" Else ShowFolderList2 f1
Next

Set fc = f.Files
For Each f1 In fc
    Debug.Print folderspec & f1.Name

    Select Case UCase(fs.GetExtensionName(folderspec & f1.Name))
           Case "JPG"
                If Sheets("Visualizador").OptionButton1.Value = True Or _
                   Sheets("Visualizador").OptionButton4.Value = True Then
                   GoTo Lancar
                Else
                   GoTo Pular
                End If
           Case "GIF"
                If Sheets("Visualizador").OptionButton2.Value = True Or _
                   Sheets("Visualizador").OptionButton4.Value = True Then
                   GoTo Lancar
                Else
                   GoTo Pular
                End If
           Case "BMP"
                If Sheets("Visualizador").OptionButton3.Value = True Or _
                   Sheets("Visualizador").OptionButton4.Value = True Then
                   GoTo Lancar
                Else
                   GoTo Pular
                End If
           Case Else
                GoTo Pular
    End Select
    
Lancar:
    Sheets("Visualizador").ListBox2.AddItem folderspec & f1.Name
    
Pular:

Next
End Sub

Na verdade havia duas coisas erradas.. os nomes dos controles (OptionButtons).. estavam errados..
E a palavra WorkSheets... deveria ser somente Sheets

 
Postado : 17/07/2015 10:29 pm
(@xman2000)
Posts: 178
Estimable Member
Topic starter
 

AdGere! Fantástico!

o botão TodosDiretorios (todos os arquivos de qualquer tipo) nao funcionou.

por hora vou descansar, dia 18-juho à tarde eu volto a estudar.
ainda vai ficar faltando o resto do sistema.
se vc quiser discutir sobre parceria estou aberto, tenho coisas legais.
abraço.

 
Postado : 17/07/2015 10:46 pm
Página 3 / 6