Notifications
Clear all

acesso a outro arquivo

7 Posts
2 Usuários
0 Reactions
1,282 Visualizações
(@laeoli)
Posts: 85
Estimable Member
Topic starter
 

Bom Dia!
Senhores tentei, mas não consigo e solicito humildemente a vossa ajuda. trata-se de uma ListBox que seria carregada com os nomes das abas de outro arquivo, e ao clicar no nome selecionado uma outra lista é carregada com cada linha que compõe esta aba (coluna A), depois vou retirar alguns dados contidos na linha (coluna E e coluna AP).

segue em anexo as duas planilhas.

Obrigado!

 
Postado : 05/12/2013 3:27 am
(@fernandofernandes)
Posts: 43750
Illustrious Member
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!

Aqui já algo próximo do que precisa
http://www.exceltip.com/user-forms-inpu ... excel.html

Att

 
Postado : 05/12/2013 5:21 am
(@laeoli)
Posts: 85
Estimable Member
Topic starter
 

ok. alex, valeu pelas dicas!

Já havia consultado estes link's, consegui acessar o outro arquivo, mas só consigo carregar as abas e as linhas da coluna A juntas na ListBox ou na ComboBox. Preciso que as abas sejam carregadas no Combobox e ao clicar nome item selecionado (planilha) a lista é carregada com a coluna A daquela aba. segue o codigo:

Private Sub UserForm_Initialize()
Dim ListItems As Variant, i As Integer
Dim SourceWB As Workbook
Dim OSheet As Object
Dim lCount As Long

    With Me.ComboBox1
        .Clear ' remove existing entries from the listbox
        ' turn screen updating off,
        ' prevent the user from seeing the source workbook being opened
        Application.ScreenUpdating = False
        ' open the source workbook as ReadOnly
        Set SourceWB = Workbooks.Open("C:UsersLaerteDesktopBD Eng.xls", _
            False, True)
            
        ReDim StrSheets(Sheets.Count - 1)
            
        For Each OSheet In Sheets
            Let StrSheets(lCount) = OSheet.Name
            Let lCount = lCount + 1
        Next OSheet
        
        For lCount = LBound(StrSheets) To UBound(StrSheets)
           Let Cells(lCount + 1, 1) = StrSheets(lCount)
        Next lCount
        End With
        With Me.ComboBox1
            
        ListItems = SourceWB.Worksheets(1).Range("A2:A21").Value
        ' get the values you want
         
        SourceWB.Close False ' close the source workbook without saving changes
        Set SourceWB = Nothing
        Application.ScreenUpdating = True
        ListItems = Application.WorksheetFunction.Transpose(ListItems)
        ' convert values to a vertical array
        For i = 1 To UBound(ListItems)
            .AddItem ListItems(i) ' populate the listbox
        Next i
        .ListIndex = -1 ' no items selected, set to 0 to select the first item
    End With
    
End Sub

Obrigado, pela ajuda e compreesão!

 
Postado : 05/12/2013 9:11 am
(@laeoli)
Posts: 85
Estimable Member
Topic starter
 

Olá pessoal!
Estou quase conseguindo, só não consigo impedir que a ComboBox2 traga a cabeça da coluna "referencia" (vide imagem).

Por favor, solicito vossa ajuda, segue abaixo o codigo e imagem da comboBox2:

Private Sub ComboBox1_Change()
ComboBox2.Clear
Sheets(ComboBox1.List(ComboBox1.ListIndex)).Select
'plan1          0

 For Each x In Worksheets
 Do While ActiveCell.Value <> ""
   ComboBox2.AddItem ActiveCell
   ActiveCell.Cells(2, 1).Select
   Loop
   Next

End Sub

Private Sub UserForm_Initialize()
   Call CarregaClientes
End Sub
 
Private Sub CarregaClientes()

    Dim linha As Integer, coluna As Integer
    linha = 2
    coluna = 1
    With Me.ComboBox1
    Set SourceWB = Workbooks.Open("C:UsersLaerteDesktopBD Eng.xls", _
            False, True)

             For Each x In Worksheets
        ComboBox1.AddItem x.Name
    Next
    End With
         
            
   
End Sub
 
Postado : 06/12/2013 4:42 pm
(@laeoli)
Posts: 85
Estimable Member
Topic starter
 

boa Tarde!

Consegui acessar, mas estou tendo problemas de dados duplicados ao carregar a ComboBox 2.

Help-me, please!

Private Sub Preenche()
Dim UltimaLinha As Integer, y As Long

ComboBox2.Clear
Sheets(ComboBox1.List(ComboBox1.ListIndex)).Select


For Each x In Worksheets
    UltimaLinha = Cells(Cells.Row.Count, "A").End(xlUp).Row
    For y = 1 To UltimaLinha - 1
        
              
          ComboBox2.AddItem Cells(y + 1, 1).Value
            'ComboBox2.AddItem Cells(y + 2, 1).Value
                    
    Next y
Next

End Sub

grato!

 
Postado : 07/12/2013 1:28 pm
(@laeoli)
Posts: 85
Estimable Member
Topic starter
 

Boa Tarde!
consegui resolver, copiei este codigo na internet e acrescentei na Sub Preenche()

 Dim Dn As Range
   Dim Dic As Object
Set Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
    Set Dic = CreateObject("scripting.dictionary")
        Dic.CompareMode = vbTextCompare :mrgreen: 
For Each Dn In Rng
  If Not Dn = vbNullString Then Dic(Dn.value) = Empty
Next
With Me.ComboBox2
    .RowSource = ""
    .List = Dic.Keys
    .ListIndex = 0
End With
    Next y[color=#FF0040][/color]
 
Postado : 07/12/2013 2:05 pm