Escolhas na ComboBox

[CAMILOALVES]

Boa Tarde!
Solicitação de Ajuda:
1) Que na Combobox seja disponibilizado uma lista sumarizada com os equipamentos contidos a partir da coluna "C5";
OBSERVAÇÃO: Note que por vezes tais equipamentos se repetem, isso deve-se aos fatores: "Unidade Operacional" e "Sistema Funcional";
2) A Coluna "C" (Equipto) pode futuramente sofrer acréscimos de novos equipamentos, ou seja, não deve ser "engessada", permitindo assim a inclusão de novas variáveis seguindo o padrão do cabeçalho (Nº ,Equipto ,Unidade Operacional ,Sistema Funcional ,Verificação ,Resp ,D ,S ,M ,TR ,SE ,A ,Tempo Programado);
3) Se possível, após escolha do equipamento e a exibição dos respectivas informações do mesmo, em caso de quebra de página, a cada quebra que seja exibido também o cabeçalho: (Nº ,Equipto ,Unidade Operacional ,Sistema Funcional ,Verificação ,Resp ,D ,S ,M ,TR ,SE ,A ,Tempo Programado);
RESSALVA: Caso não seja possível o desenvolvimento do item 3 da solicitação, considerar somente as solicitações dos itens 1 e 2.
Segue Planilha Anexo.
Desde já agradeço!

[Wagner Morel]

Camilo,

Boa noite!

Veja se pode ser assim.

[CAMILOALVES]

Prezado Wagner Morel » Dom Jul 26, 2020 9:30 pm, Bom Dia!
Primeiramente muito obrigado por dispor de seu tempo em ajudar-me, assim como o Srº gentilmente o fez em outras oportunidades.
Então.... ao efetuar testes, notei que na combo solicitada, está fixado o equipamento "GUILHOTINA", não permitindo outras escolhas, ou seja, não aparecem os demais equipamentos na lista da combo, e também a área de impressão não está levando em consideração o último registro da planilha, ou seja, está imprimindo toda a planilha mesmo as partes sem dados.
Caso Seja Possível, Peço Que o Srº Reavalie a Planilha.
Atenciosamente

[Wagner Morel]

Ok. Veja se consegui resolver agora.

[CAMILOALVES]

Boa tarde Srº Wagner Morel!
Perfeito! era isso mesmo o esperado, vou replicar a solução para algumas planilhas, para isso sei que devo entrar no código e trocar os nomes das planilhas e também a referências das células, até aí tudo bem.
Porém solicito se possível, que o Srº me oriente nos seguintes ponto da planilha original (Plan1):
1) O macro deve ser colocada integralmente em “Plan1”? ou seja, clico com o botão direito do mouse e insiro o referido código?
2) Quanto a combobox, como foi o processo? o Srº após inseri-la qual foi o procedimento para que nela fossem exibidos os equipamentos?
Desde já agradeço pela atenção

[Wagner Morel]

No módulo da Plan1 devem ser inseridas as seguintes procedures:

Código: Selecionar todos

Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Count > 1 Then
        Application.EnableEvents = True
        Exit Sub
    End If

    If Target.Row > 4 And Target.Column = 3 Then
         Call Atualizar
    End If
    Application.EnableEvents = True
End Sub

Private Sub Cmb_Equip_Change()
    Dim i As Long
    Dim UltimaLinha As Long

    'Armazedna a última linha com dados pela coluna C
    UltimaLinha = Sheets("Plan1").Cells(Cells.Rows.Count, "C").End(xlUp).Row
    
    'Filtra de acordo com o que foi escolhido no Combo
    ActiveSheet.Range("$B$4:$N$" & UltimaLinha).AutoFilter Field:=2, Criteria1:=Cmb_Equip.Value
    
    'Limpa a área de impressão
    ActiveSheet.PageSetup.PrintArea = ""
    
    'Define a área de impressão
    Range("B4").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    'Armazena a última linha com dados pela coluna C
    UltimaLinha = Sheets("Plan1").Cells(Cells.Rows.Count, "C").End(xlUp).Row
    ActiveSheet.PageSetup.PrintArea = "$B$4:$N$" & UltimaLinha
    Range("B4").Select

    'Exibe os dados
    ActiveWindow.SelectedSheets.PrintPreview
End Sub
Sub Atualizar()
    Application.EnableEvents = False
    Dim i As Long
    Dim UltimaLinha As Long

    'Limpa a coluna XFD
    Columns("XFD:XFD").Select
    Selection.ClearContents

    'Copia os dados da coluna C para a coluna XFD
    Range("C4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("XFD1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

    'Armazedna a última linha com dados pela coluna XFD
    UltimaLinha = Sheets("Plan1").Cells(Cells.Rows.Count, "XFD").End(xlUp).Row
    'Remove as duplicatas
    ActiveSheet.Range("$XFD$1:$XFD$" & UltimaLinha).RemoveDuplicates Columns:=1, Header:=xlYes

    'Armazedna a última linha com dados pela coluna XFD
    UltimaLinha = Sheets("Plan1").Cells(Cells.Rows.Count, "XFD").End(xlUp).Row

    'Coloca os dados em ordem alfabética crescente
    Range("XFD1").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Plan1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Plan1").Sort.SortFields.Add Key:=Range("XFD2:XFD" & UltimaLinha), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Plan1").Sort
        .SetRange Range("XFD1:XFD" & UltimaLinha)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    'Limpa o combo
    Sheets("Plan1").Cmb_Equip.Clear

    'Preenche o combo
    For i = 2 To UltimaLinha
        Sheets("Plan1").Cmb_Equip.AddItem Range("XFD" & i).Value
    Next i
    Range("A1").Select
    Application.EnableEvents = True
End Sub

No Módulo de "EstaPasta_de_trabalho" deve ser inserido:

Código: Selecionar todos

Private Sub Workbook_Open()
    Application.EnableEvents = False
    Dim i As Long
    Dim UltimaLinha As Long

    'Limpa a coluna XFD
    Columns("XFD:XFD").Select
    Selection.ClearContents

    'Copia os dados da coluna C para a coluna XFD
    Range("C4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("XFD1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

    'Armazedna a última linha com dados pela coluna XFD
    UltimaLinha = Sheets("Plan1").Cells(Cells.Rows.Count, "XFD").End(xlUp).Row
    'Remove as duplicatas
    ActiveSheet.Range("$XFD$1:$XFD$" & UltimaLinha).RemoveDuplicates Columns:=1, Header:=xlYes

    'Armazedna a última linha com dados pela coluna XFD
    UltimaLinha = Sheets("Plan1").Cells(Cells.Rows.Count, "XFD").End(xlUp).Row

    'Coloca os dados em ordem alfabética crescente
    Range("XFD1").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Plan1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Plan1").Sort.SortFields.Add Key:=Range("XFD2:XFD" & UltimaLinha), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Plan1").Sort
        .SetRange Range("XFD1:XFD" & UltimaLinha)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    'Limpa o combo
    Sheets("Plan1").Cmb_Equip.Clear

    'Preenche o combo
    For i = 2 To UltimaLinha
        Sheets("Plan1").Cmb_Equip.AddItem Range("XFD" & i).Value
    Next i
    Range("A1").Select
    Application.EnableEvents = True
End Sub

Na Plan1, ao invés daquele tipo de controle que você havia inserido (Controle de Formulário ComboBox) você deve apagar e inserir um ComboBox do tipo Controle ActiveX. Depois, clica com o botão direito do mouse em cima do controle, entra em propriedades e muda a propriedade name dele para Cmb_Equip.

[CAMILOALVES]

Boa tarde Srº Wagner Morel!
Primeiramente muito obrigado pelas explicações!
Então...Quando abre o arquivo pela 1ª vez, a combo foi abastecida normalmente, ou seja, exibiu uma listagem de equipamentos, porém após escolha de um determinado equipamento e após salvar o arquivo, na reabertura do mesmo a combo trás consigo o equipamento da última pesquisa e não deixa exibir a listagem dos demais equipamentos.
Se Possível Peço Que o Srº Verifique a Intercorrência
OBS: Segue planilha para análise
Atenciosamente

[Wagner Morel]

Camilo,

Boa noite!

Segue arquivo com a correção.

[CAMILOALVES]

Bom Dia Srº Wagner Morel!
Primeiramente muito obrigado pela paciência!
OK! Tudo Certo, Implementado.
DEUS continue lhe provendo cada vez mais conhecimento.
Atenciosamente