Reinaldo, função semelhante ao do modelo do ambientoffice, podemos encontrar no link abaixo, não sei se foi este o endereço que o Fernando indicou, eles têm outros modelos bem interessantes.
http://www.interactiveds.com.au/software.html
Mas voltando a questão, o Fernando havia postado tambem no forum do Tomas e como a resposta primeira foi aqui, então continuamos daqui, e conforme eu passei a ele, se chegarmos a uma solução plausivel eu coloco la.
Pelo que entendi, conforme explicação dele no forum do Tomas, eu acredito que o ideal é a conexão ADO, uma vez que como ele mesmo disse tambem este recurso le celula por celula o que irá demandar muito tempo de programação pela qde de dados que disse ter no BD, mas ele diz que o incoveniente é usar ADO é ter de deixar o BD aberto, e como eu disse, se ele usou o Modelo de Cadastro do Tomas, o BD é aberto, mas fica com a condição de oculto uma vez que são feitas alterações atraves do formuláro de Cadastro, mas como é somente para buscar dados não necessitaria estar aberto, não tenho certeza, pois não utilizo muito este recurso, fiquei de pesquisar e dar uma posição, mas, se você tiver alguma experiência com ADO poderá confirmar se é isto mesmo.
Quanto ao modelo que colocou, fiz alguns testes e vi que as rotinas puxam os dados das colunas 1 até a 8, acredito que nas adaptações que fez acabou pássando despercebido, ou seja, se a intensão é puxar os dados somente das colunas que estão no Vetor, temos de ajustar as linhas :
Na rotina :
Sub Laco()
Trocar esta:
sEnd = Cells(Linha, Col).Address por esta : sEnd = Cells(Linha, (ColunasSolicitadas(Col))).Address.
e na :
'Executar esta rotina para testar a função ObterDadosExternos
Sub Teste()
Trocar esta:
sEnd = Cells(Linha, Col).Address por esta : sEnd = Cells(Linha, (ColunasSolicitadas(Col))).Address.
e esta:
Sheets("Plan2").Cells(Linha, Col) = GetValue(sPath, sPasta, sPlan, sEnd), por esta :
Sheets("Plan2").Cells(Linha, Col) = ObterDadoExterno(sPath, sPasta, sPlan, sEnd)
Como estamos falando de Array, e adaptando suas rotinas, poderiamos fazer da seguinte forma:
Sub LacoArray()
Dim sPath As String, sPasta As String, sPlan As String, sEnd As String
Dim nRow As Integer
Dim ColunasSolicitadas As Variant
Dim Col
'Carregando as informações de caminho e arquivo
sPath = Sheets("Plan1").Range("F1") 'ThisWorkbook.path
sPasta = Sheets("Plan1").Range("F2") '"banco.xlsx"
sPlan = Sheets("Plan1").Range("F3") '"Plan1"
'Informa o numero de linhas
nRow = 10
'Carregando Array de colunas
ColunasSolicitadas = Array(2, 3, 4, 5, 8, 11, 13, 21)
For Linha = 2 To nRow
For Each Col In ColunasSolicitadas
sEnd = Cells(Linha, Col).Address
Sheets("Plan2").Cells(Linha, Col) = GetValue(sPath, sPasta, sPlan, sEnd)
Columns(Col).AutoFit
Next Col
Next Linha
End Sub
Ou :
'Executar esta rotina para testar a função ObterDadosExternos
Sub TesteArray()
Dim sPath As String, sPasta As String, sPlan As String, sEnd As String
Dim nRow As Integer, Linha As Integer
Dim ColunasSolicitadas As Variant
Dim Col
'Carregando as informações de caminho e arquivo
sPath = Sheets("Plan1").Range("F1") 'ThisWorkbook.path
sPasta = Sheets("Plan1").Range("F2") '"banco.xlsx"
sPlan = Sheets("Plan1").Range("F3") '"Plan1"
'Carregando Array de colunas
ColunasSolicitadas = Array(2, 3, 4, 5, 8, 11, 13, 21)
'Informa o numero de linhas
nRow = 10
'Imprime valor do endereço acima da janela de Verificação imediata:
'Debug.Print ObterDadoExterno(sPath, sPasta, sPlan, sEnd)
For Linha = 2 To nRow
For Each Col In ColunasSolicitadas
sEnd = Cells(Linha, Col).Address
Sheets("Plan2").Cells(Linha, Col) = ObterDadoExterno(sPath, sPasta, sPlan, sEnd)
Columns(Col).AutoFit
Next Col
Next Linha
End Sub
As adaptações é mais para ilustrar a utilização das possiveis variações com Arrays, uma vez que temos os mesmoos resultados e efeitos, só necessitaria testar cada uma com o BD maior para ver se ha variações no tempo de processamento, se pesquisarmos na Net encontramos uma infinidade de exemplos sobre o assunto.
De qualquer forma, é aguardarmos uma posição do Fernando.
[]s
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
Postado : 26/02/2014 9:41 pm