Risultati da 1 a 5 di 5

Discussione: Rubrica + ricerca + piccoli accorgimenti



  1. #1
    L'avatar di domenico.frau
    Clicca e Apri
    Data Registrazione
    May 2016
    Località
    Villasimius
    Messaggi
    3
    Versione Office
    2013
    Likes ricevuti
    0
    Likes dati
    0

    Rubrica + ricerca + piccoli accorgimenti

    Buonasera, vorrei porre alcune domande, o meglio dire richieste, che spero possiate rendere possibili.
    Parto col dire che con excel me la cavo, ma non ne faccio un uso avanzato. Quindi tutto ciò che riguarda VBA per me è sanscrito.
    E' altrettanto vero che la rubrica creata e postata in un altro theard per me è importantissima. Però con alcune modifiche.
    Ho provato a modificarla come vorrei che fosse, però non sono riuscito a "legare" il codice all'interfaccia (che appare quando si clicca cerca).
    La mia prima domanda quindi è:
    - c'è qualche anima buona e paziente che abbia voglia e tempo per applicare queste modifiche?

    Lavorando in un magazzino di un villaggio turistico, utilizzerei questa rubrica praticamente ogni giorno. Mi servirebbe avere un secondo foglio, nel quale mettere tutti gli interni del villaggio, con una ricerca differente;
    che si limita quindi alle colonne inserite da me.

    La seconda e ultima richiesta è quella dell'aggiunta della funzione "precedente" oltre alla "successivo" già intelligentemente inserita da chi ha creato il file.

    Spero di non essere stato troppo esigente.
    Vogliate scusare uno che di excel non capisce molto! :256:
    Grazie in anticipo a chi volesse aiutarmi..
    File Allegati File Allegati

  2. #2

    L'avatar di ges
    Clicca e Apri
    Data Registrazione
    Jun 2015
    Località
    Como
    Età
    53
    Messaggi
    7165
    Versione Office
    2011MAC 2016WIN
    Likes ricevuti
    2065
    Likes dati
    1304

    Re: Rubrica + ricerca + piccoli accorgimenti

    Ciao Domenico, vista la richiesta sposto nella sezione macro.
    Quando si scartano tutte le ipotesi possibili, quella che resta, anche se può sembrare improbabile, non può che essere quella giusta!

  3. #3
    L'avatar di Raffaele_53
    Clicca e Apri
    Data Registrazione
    Dec 2015
    Località
    Binasco
    Età
    64
    Messaggi
    506
    Versione Office
    2007
    Likes ricevuti
    85
    Likes dati
    7

    Re: Rubrica + ricerca + piccoli accorgimenti

    Dovrebbe funzionare, provalo

    Codice: 
    
    
    
    Private Sub CmdAzzera_Click()
    
    
    TxtCognome = ""
    TxtNome = ""
    TxtPIVA = ""
    TextBox1 = ""
    TextBox2 = ""
    TextBox3 = ""
    TxtCognome.SetFocus
    
    
    End Sub
    
    
    Private Sub CmdCerca_Click()
    On Error GoTo nonce
    Dim wsh As Worksheet
    Dim uriga As Long
    
    
    Set wsh = ThisWorkbook.Worksheets("RUBRICA")
    uriga = wsh.Cells(Rows.Count, 1).End(xlUp).Row
    
    
    If TxtCognome <> "" Then
        Range("A1:A" & uriga).Select
        Cells.Find(What:=TxtCognome, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
        X = 0
        ActiveCell.Offset(0, 0).Select
    ElseIf TxtNome <> "" Then
        Range("B1:B" & uriga).Select
        Cells.Find(What:=TxtNome, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
        X = 1
        ActiveCell.Offset(0, -1).Select
    ElseIf TxtPIVA <> "" Then
        Range("C1:C" & uriga).Select
        Cells.Find(What:=TxtPIVA, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
        X = 2
        ActiveCell.Offset(0, -2).Select
    Else
        Exit Sub
    End If
    TxtCognome = ActiveCell.Offset(0, 0).Value
    TxtNome = ActiveCell(1, 2).Value
    TxtPIVA = ActiveCell(1, 3).Value
    TextBox1 = ActiveCell(1, 4).Value
    TextBox2 = ActiveCell(1, 5).Value
    TextBox3 = ActiveCell(1, 6).Value
    GoTo finito
    nonce:
    MsgBox ("La ricerca non ha prodotto alcun risultato"), vbInformation
    finito:
    Application.CutCopyMode = False
    Set wsh = Nothing
    End Sub
    
    
    Private Sub CmdFine_Click()
    X = 0
    Unload UsrFormRubrica
    
    
    End Sub
    
    
    Private Sub CmdScrivi_Click()
    
    
    Dim wsh As Worksheet
    Dim uriga As Long
    
    
    Set wsh = ThisWorkbook.Worksheets("RUBRICA")
    uriga = wsh.Cells(Rows.Count, 1).End(xlUp).Row + 1
    Range("A" & uriga).Value = UCase(TxtCognome)
    Range("B" & uriga).Value = UCase(TxtNome)
    Range("C" & uriga).Value = TxtPIVA
    Range("D" & uriga).Value = TextBox1
    Range("E" & uriga).Value = TextBox2
    Range("F" & uriga).Value = TextBox3
    TxtCognome = ""
    TxtNome = ""
    TxtPIVA = ""
    TextBox1 = ""
    TextBox2 = ""
    TextBox3 = ""
    TxtCognome.SetFocus
    
    
    Set wsh = Nothing
    
    
    End Sub
    
    
    Private Sub CmdSuccessivo_Click()
    
    
    On Error GoTo nonce
    Dim wsh As Worksheet
    Dim uriga As Long
    Set wsh = ThisWorkbook.Worksheets("RUBRICA")
    uriga = wsh.Cells(Rows.Count, 1).End(xlUp).Row
    
    
    If X = 0 Then
        If TxtCognome <> "" Then
            Range(ActiveCell.Offset(1, 0).Address & ":" & ActiveCell.End(xlDown).Address).Select
            Selection.Find(What:=TxtCognome, After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
        End If
    ElseIf X = 1 Then
        If TxtNome <> "" Then
            Range(ActiveCell.Offset(1, 1).Address & ":" & ActiveCell.End(xlDown).Address).Select
            Selection.Find(What:=TxtNome, After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
            ActiveCell.Offset(0, -1).Select
        End If
    Else
        Range(ActiveCell.Offset(1, 2).Address & ":" & ActiveCell.End(xlDown).Address).Select
            Selection.Find(What:=TxtPIVA, After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Offset(0, -2).Select
    End If
    TxtCognome = ActiveCell.Offset(0, 0).Value
    TxtNome = ActiveCell(1, 2).Value
    TxtPIVA = ActiveCell(1, 3).Value
    TextBox1 = ActiveCell(1, 4).Value
    TextBox2 = ActiveCell(1, 5).Value
    TextBox3 = ActiveCell(1, 6).Value
    GoTo finito
    
    
    nonce:
    MsgBox ("La ricerca è terminata"), vbInformation
    Application.CutCopyMode = False
    Range("A1").Select
    Set wsh = Nothing
    finito:
    Application.CutCopyMode = False
    Set wsh = Nothing
    
    
    End Sub
    
    
    Private Sub CmdStampa_Click()
         UsrFormRubrica.PrintForm
    End Sub
    
    
    Private Sub CmdPDF_Click()
    
    
     Dim WshNet As Object
     Set WshNet = CreateObject("Wscript.Network")
     WshNet.SetDefaultPrinter "doPDF v7" ' Qui cambio la stampante
     UsrFormRubrica.PrintForm
    WshNet.SetDefaultPrinter "HP LaserJet 1020" ' Qui cambio la stampante
    
    
    End Sub
    File Allegati File Allegati
    Ultima modifica fatta da:Gerardo Zuccalà; 08/06/16 alle 01:47

  4. #4
    L'avatar di domenico.frau
    Clicca e Apri
    Data Registrazione
    May 2016
    Località
    Villasimius
    Messaggi
    3
    Versione Office
    2013
    Likes ricevuti
    0
    Likes dati
    0

    Re: Rubrica + ricerca + piccoli accorgimenti

    Grazie Raffaele, il file funziona correttamente, ed è proprio quello che cercavo.
    L'unia cosa che vorrei che ancora manca è la ricerca per reparto e per riferimento.
    Sapresti aiutarmi?

    Grazie

  5. #5
    L'avatar di Raffaele_53
    Clicca e Apri
    Data Registrazione
    Dec 2015
    Località
    Binasco
    Età
    64
    Messaggi
    506
    Versione Office
    2007
    Likes ricevuti
    85
    Likes dati
    7

    Re: Rubrica + ricerca + piccoli accorgimenti

    Per la ricerca "precedente", bisogna stravolgere tutto il codice
    Alla stampa non riesco dargli il cognome in automatico
    Per reparto e riferimento, funziona. Allego codice modificato
    Codice: 
       If Col <> 0 Then
        Set Area = wsh.Range(wsh.Cells(Rig + 1, Col), wsh.Cells(Rig + uriga, Col))
        Set Rg = Area.Find(Val, LookIn:=xlValues, LookAt:=xlWhole)
            If Rg Is Nothing Then
               MsgBox ("Nessun altro dato, la ricerca è terminata"), vbInformation
               GoTo fine
            Else
                Rig = Rg.Row
                TxtCognome = Cells(Rig, 1).Value
                TxtNome = Cells(Rig, 2).Value
                TxtPIVA = Cells(Rig, 3).Value
                TextBox1 = Cells(Rig, 4).Value
                TextBox2 = Cells(Rig, 5).Value
                TextBox3 = Cells(Rig, 6).Value
            End If
    File Allegati File Allegati

Discussioni Simili

  1. [Risolto] Modifica UserForm Rubrica
    Di roky48 nel forum Domande su Excel VBA e MACRO
    Risposte: 14
    Ultimo Messaggio: 17/11/16, 00:47
  2. rubrica clienti
    Di t.corvo nel forum Domande su Excel in generale
    Risposte: 18
    Ultimo Messaggio: 02/10/16, 17:43
  3. Maiuscolo in VBA e piccoli aggiustamenti
    Di G.Bove nel forum Domande su Excel VBA e MACRO
    Risposte: 10
    Ultimo Messaggio: 23/07/16, 20:50
  4. Modifica a rubrica
    Di roky48 nel forum Domande su Excel VBA e MACRO
    Risposte: 32
    Ultimo Messaggio: 14/06/16, 17:38
  5. Matematica per piccoli e perchè no... per grandi
    Di Baloon_50 nel forum Lavori e giochi con Excel
    Risposte: 9
    Ultimo Messaggio: 12/01/16, 09:28

Permessi di Scrittura

  • Tu non puoi inviare nuove discussioni
  • Tu non puoi inviare risposte
  • Tu non puoi inviare allegati
  • Tu non puoi modificare i tuoi messaggi
  •