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.
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
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.
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
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"
--------------------------------------------------------------
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
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
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.
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
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.NameWith 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
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
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.
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.
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 optJPGEnd 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..
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
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.