You are here:--[RISOLTO] Evitare salti di foglio
[RISOLTO] Evitare salti di foglio2019-03-01T15:46:08+01:00

Home Forum Domande su Excel VBA e MACRO [RISOLTO] Evitare salti di foglio

  • Autore
    Articoli
  • Avatarteto21162
    Partecipante
      Post totali: 79

      Salve Ragazzi,

      nel vba del foglio riepilogo di appuntamenti uso uncodice che poi posterò per copiare un dato di cella come si vede nel codice ci sono delle call che eseguono altre funzioni sia in un foglio

      dello stesso file sms  ( Call COPIA_appiuntamento_in_calendario_3)

      che in un foglio di un’altro file anagrafica-anno. Call FILTRA_ANAGRAFICA_E_COPIA_TELEFONO_CLIENTE

      tutto funziona ma vorrei evitare la visione del salto all’altro file.

      Ho provato con l’utilizzo di Application.ScreenUpdating nel vba

      foglio ma il salto avviene comunque.

      I codici in questione li racchiudo per comodità di chi legge in post successivi a questo

      Grazie a tutti

      Teto

      • Questo argomento è stato modificato 9 mesi, 1 settimana fa da Avatar teto21162.
      • Questo argomento è stato modificato 8 mesi, 2 settimane fa da sid sid.
    • Avatarteto21162
      Partecipante
        Post totali: 79

        Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

        Application.ScreenUpdating = False

        ‘Application.EnableEvents = False

        riga = ActiveCell.Row

        ‘ind = Target.Address(RowAbsolute:=False, ColumnAbsolute:=False)

        Application.EnableEvents = True

        If riga < 5 Or riga > 2002 Then GoTo labf

        ‘If Mid(ind, 2) < 5 Or Mid(ind, 2) > 2002 Then GoTo labf

         

        If ActiveCell.Column = 3 Then ‘lunedì

        Set zona1 = Range(ActiveCell, ActiveCell.Offset(0, 4))

        zona1.Select

        zona1.Font.ColorIndex = 7 ‘2

        zona1.Interior.ColorIndex = 7 ‘3

        zona1.Copy

        Call COPIA_appiuntamento_in_calendario_3

        ‘Call FILTRA_ANAGRAFICA_E_COPIA_TELEFONO_CLIENTE

         

        Application.CutCopyMode = False

         

        End If

         

        If ActiveCell.Column = 8 Then ‘martedì

        Set zona2 = Range(ActiveCell, ActiveCell.Offset(0, 4))

        zona2.Select

        zona2.Font.ColorIndex = 7 ‘2

        zona2.Interior.ColorIndex = 7 ‘3

        zona2.Copy

        Call COPIA_appiuntamento_in_calendario_3

        ‘Call FILTRA_ANAGRAFICA_E_COPIA_TELEFONO_CLIENTE

         

        Application.CutCopyMode = False

        End If

         

        If ActiveCell.Column = 13 Then ‘mercoledì

        Set zona3 = Range(ActiveCell, ActiveCell.Offset(0, 4))

        ‘zona3.Select

        zona3.Font.ColorIndex = 7 ‘2

        zona3.Interior.ColorIndex = 7 ‘3

        zona3.Copy

        Call COPIA_appiuntamento_in_calendario_3

        ‘Call FILTRA_ANAGRAFICA_E_COPIA_TELEFONO_CLIENTE

         

        Application.CutCopyMode = False

        End If

         

        If ActiveCell.Column = 18 Then ‘giovedì

        Set zona4 = Range(ActiveCell, ActiveCell.Offset(0, 4))

        zona4.Select

        zona4.Font.ColorIndex = 7 ‘2

        zona4.Interior.ColorIndex = 7 ‘3

        zona4.Copy

        Call COPIA_appiuntamento_in_calendario_3

        ‘Call FILTRA_ANAGRAFICA_E_COPIA_TELEFONO_CLIENTE

         

        Application.CutCopyMode = False

        End If

         

        If ActiveCell.Column = 23 Then ‘venerdì

        Set zona5 = Range(ActiveCell, ActiveCell.Offset(0, 4))

        zona5.Select

        zona5.Font.ColorIndex = 7 ‘2

        zona5.Interior.ColorIndex = 7 ‘3

        zona5.Copy

        Call COPIA_appiuntamento_in_calendario_3

        ‘Call FILTRA_ANAGRAFICA_E_COPIA_TELEFONO_CLIENTE

         

        Application.CutCopyMode = False

        End If

         

        If ActiveCell.Column = 28 Then ‘sabato

        Set zona6 = Range(ActiveCell, ActiveCell.Offset(0, 4))

        zona6.Select

        zona6.Font.ColorIndex = 7 ‘2

        zona6.Interior.ColorIndex = 7 ‘3

        zona6.Copy

        Call COPIA_appiuntamento_in_calendario_3

        ‘Call FILTRA_ANAGRAFICA_E_COPIA_TELEFONO_CLIENTE

        Application.CutCopyMode = False

        End If

         

        If ActiveCell.Column = 33 Then ‘domenica

        Set zona7 = Range(ActiveCell, ActiveCell.Offset(0, 4))

        zona7.Select

        zona7.Font.ColorIndex = 7 ‘2

        zona7.Interior.ColorIndex = 7 ‘3

        zona7.Copy

        Call COPIA_appiuntamento_in_calendario_3

        ‘Call FILTRA_ANAGRAFICA_E_COPIA_TELEFONO_CLIENTE

         

        Application.CutCopyMode = False

        End If

         

        labf: ‘da mettere dopo l’end if

         

        Call FILTRA_ANAGRAFICA_E_COPIA_TELEFONO_CLIENTE

        Call avvia_CONTROLLO_presenza_dicitura

         

        Application.ScreenUpdating = True

        ‘Call avvia_CONTROLLO_presenza_dicitura

         

        End Sub

         

        • Avatarteto21162
          Partecipante
            Post totali: 79

            Sub COPIA_appiuntamento_in_calendario_3()

             

            Windows(“APPUNTAMENTI.xls”).Activate

             

            Sheets(“sms”).Activate

            With Sheets(“sms”)

            .Range(“e23”).PasteSpecial Paste:=xlValues ‘ INCOLLA nome

            End With

             

            Sheets(“sms”).Activate

            With Sheets(“sms”)

            .Range(“A2”).Copy ‘ copia data

            End With

            With Sheets(“sms”)

            .Range(“E2”).PasteSpecial Paste:=xlValues ‘ INCOLLA data

            End With

             

             

            Application.CutCopyMode = False

            End Sub

             

        • Avatarteto21162
          Partecipante
            Post totali: 79

            Public Sub FILTRA_ANAGRAFICA_E_COPIA_TELEFONO_CLIENTE()

             

            Windows(“APPUNTAMENTI.xls”).Activate

            Sheets(“sms”).Activate

            With Sheets(“sms”)

            .Range(“F1”).Copy ‘ copia NOME FILTRATO

            End With

             

            Windows(“ANAGRAFICA-ANNO.xls”).Activate

            Sheets(“DATI-CONTABILI”).Activate

            With Sheets(“DATI-CONTABILI”)

            .Range(“A10”).PasteSpecial Paste:=xlValues ‘ INCOLLA NOME FILTRATO

            End With

             

             

            Application.CutCopyMode = False

             

            Windows(“ANAGRAFICA-ANNO.xls”).Activate

            Sheets(“DATI-CONTABILI”).Activate

            Selection.AutoFilter ‘ disattiva il filtro (riga da aggiungere)

            Range(“A10:CZ10”).Select ‘ rimette il filtro (riga da aggiungere)

             

            Selection.AutoFilter

            Selection.AutoFilter Field:=6, Criteria1:=Range(“A10”)

            With Sheets(“DATI-CONTABILI”)

            .Range(“F10:F10000”).SpecialCells(xlCellTypeVisible).End(xlDown).Offset(0, 14).Copy ‘ COPIA segno zodiacale

            End With

             

            Windows(“APPUNTAMENTI.xls”).Activate

            Sheets(“sms”).Activate

            With Sheets(“sms”)

            .Range(“B18″).PasteSpecial Paste:=xlValues ‘ copia TELEFONO FILTRATO

            End With

             

             

            ActiveSheet.Protect Password:=”23581321162”, contents:=True, Scenarios:=True, _

            userInterfaceOnly:=True

             

            End Sub

             

          • sidsid
            Moderatore
              Post totali: 723

              Ciao teto
              senza il file non si può fare nulla; togli i dati sensibili e postalo

            • Avatarteto21162
              Partecipante
                Post totali: 79

                Mi dispiace Sid ma ho provato in vari modi ma non riesco a mandarti i file semplicemente senza dati, troppi collegamenti con altri file del sistema stesso.

                Pazienza se non si riesce in altro modo sono costretto a rinunciare all’idea.

                Teto :cry:

              • Avatarteto21162
                Partecipante
                  Post totali: 79

                  Ho cercato di riprodurre dei file con i codici che riguardano il problema.

                  andando in file appuntamenti foglio riepilogo e facendo doppio clic sopra ad un nome di colonna C i codici si attivano

                   

                  <br />

                   

                  <br />

                • Avatarteto21162
                  Partecipante
                    Post totali: 79

                    Ciao Sid,

                    sono utili i file che ti ho postato :bye:

                    Teto

                  • sidsid
                    Moderatore
                      Post totali: 723

                      Ciao
                      Ho scaricato i file; devi dirmi come muovermi nel dettaglio.
                      Esempio
                      – apro file “appuntamenti” (oppure l’altro)
                      – mi posiziono sul foglio xxxx
                      – continua tu….

                    • Avatarteto21162
                      Partecipante
                        Post totali: 79

                        Ciao Sid,

                        allora cerco di spiegarmi.

                        la sequenza di operazioni parte dal file appuntamenti e precisamente dal codice vba del foglio riepilogo. In pratica in questo foglio se fai doppio clic all’interno di una delle celle del range composto dalle righe 5-2002  e dalle colonne c-h-m-ecc il contenuto viene incollato sia in cella E23 del foglio sms che in cella A10 del foglio dati-contabili del file anagrafica-anno poi viene filtrato dati-contabili in base al contenuto di A10, e incollato il dato ultimo visibile di colonna T di dati-contabili nel foglio sms di appuntamenti  in cella B18.

                        Quindi se fai doppio clic su caio ( colonna C lunedì ) ottieni:

                        in sms E23 = caio

                        in sms F23 = d

                        in sms B18 = 4

                        in dati-contabili di anagrafica.. cella A10 = caio

                        e il fltraggio di colonna F su caio

                        Nel file originale questo passaggio tra un file e l’altro è visibile ( crea il solito sfarfallio ) e io vorrei che fosse invisibile.

                        Tutto il processo parte dal codice vba del foglio riepilogo quindi in testa e in coda o messo Application.ScreenUpdating  ma nonostante questo si nota lo sfarfallio, in altre situazioni è bastato qui no.

                        Cosa sbaglio c’è un altro modo per ottenere la stessa cosa?

                        Teto :bye:

                         

                        • Questa risposta è stata modificata 9 mesi fa da Avatar teto21162.
                      • sidsid
                        Moderatore
                          Post totali: 723

                          manca anche il file “file ANAGRAFICA-ANNO.xls”

                          Mi da errore in
                          Public Sub FILTRA_ANAGRAFICA_E_COPIA_TELEFONO_CLIENTE()
                          istruzione
                          Windows("file ANAGRAFICA-ANNO.xls").Activate

                        • Avatarteto21162
                          Partecipante
                            Post totali: 79

                            Ciao Sid,

                            il file : ” file anagrafica-anno ” l’hai scaricato dal post insieme a ” file appuntamenti ” ed è nominato in quel modo?

                            non vorrei che ne avessi scaricato più di uno e avessi aperto quello  con nome diverso.

                            Teto :bye:

                          • sidsid
                            Moderatore
                              Post totali: 723

                              Adesso non ho modo di stare al pc, ma il secondo file non è nominato così. Non ricordo il nome.

                            • Avatarteto21162
                              Partecipante
                                Post totali: 79

                                Strano ho provato a scaricare di nuovo e il file e il nome è  file anagrafica-anno :unsure:

                              • Avatarteto21162
                                Partecipante
                                  Post totali: 79

                                  L’unica differenza riscontrata con il codice vba è che lì e scritto in maiuscolo Windows(“file ANAGRAFICA-ANNO.xls”).Activate mentre il file è nominato file anagrafica-anno.xls

                                  Non so che dirti da me funziona perfettamente ho anche provato a inserire nel vba il nome del file preso dalle propietà tutto funziona.

                                  Non è forse che hai scaricato 2 volte e usi il secondo file scaricato al quale il sistema ha aggiunto un numero in questo caso si che darebbe errore :bye:

                                   

                                • sidsid
                                  Moderatore
                                    Post totali: 723

                                    Questi sono i file che ho

                                  • Avatarteto21162
                                    Partecipante
                                      Post totali: 79

                                      Ciao Sid,

                                      prepara i file non è mio

                                      prova a riscaricare dal mio post

                                      Teto

                                    • Avatarteto21162
                                      Partecipante
                                        Post totali: 79

                                        Per tagliare la testa al toro ti ricarico i file

                                        <br />

                                         

                                        <br />

                                      • Avatarteto21162
                                        Partecipante
                                          Post totali: 79

                                          ok provato a scaricare funziona i file sono esattamente quelli

                                          Teto

                                        • sidsid
                                          Moderatore
                                            Post totali: 723

                                            Riscaricati i file..tt ok

                                            Il problema sono i vari “select” e “activate” che anche disabilitando l’aggiornamento dello schermo, rendono visibile il leggero sfarfallio.
                                            Dovresti eliminarli, inserendo la paternità per ogni oggetto nel codice

                                          • Avatarteto21162
                                            Partecipante
                                              Post totali: 79

                                              ok grazie mille del consiglio ora ci provo

                                              Teto :good:

                                            • Avatarteto21162
                                              Partecipante
                                                Post totali: 79

                                                Ciao Sid,

                                                ho provato ma non riesco a gestire le stesse operazioni mettendo le paternità.

                                                Potresti farmi tu il codice o farmi un esempio.

                                                Grazie

                                                Teto :scratch:

                                              • sidsid
                                                Moderatore
                                                  Post totali: 723

                                                  Appena posso ti dò una mano

                                                • sidsid
                                                  Moderatore
                                                    Post totali: 723

                                                    Ho dato una semplificata al codice.
                                                    Ho accorpato tutto nell’evento del doppioclick, senza richiamare le macro del modulo1 e modulo2.
                                                    Sicuramente migliorabile.

                                                    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
                                                    Dim wb1 As Workbook, wb2 As Workbook
                                                    Dim ws1 As Worksheet, ws2 As Worksheet
                                                    Dim riga As Long
                                                    Dim zona As Range
                                                    
                                                    Set wb1 = ThisWorkbook
                                                    Set wb2 = Workbooks("file ANAGRAFICA-ANNO.xls")
                                                    Set ws1 = wb1.Sheets("sms")
                                                    Set ws2 = wb2.Sheets("DATI-CONTABILI")
                                                    
                                                    riga = Target.Row
                                                    If riga < 5 Or riga > 2002 Then GoTo labf
                                                    
                                                    Application.ScreenUpdating = False
                                                    Select Case Target.Column
                                                        Case 3, 8, 13, 18, 23, 28, 33
                                                        Set zona = Range(Target, Target.Offset(0, 4))
                                                        With zona
                                                            .Font.ColorIndex = 7 '2
                                                            .Interior.ColorIndex = 7 '3
                                                            .Copy
                                                            ws1.Range("E23").PasteSpecial Paste:=xlValues  ' INCOLLA nome
                                                        End With
                                                    End Select
                                                    
                                                    With ws1
                                                        .Range("A2").Copy
                                                        .Range("E2").PasteSpecial Paste:=xlValues     ' INCOLLA data
                                                        .Range("F1").Copy ' copia NOME FILTRATO
                                                    End With
                                                    
                                                    With ws2
                                                        .Range("A10").PasteSpecial Paste:=xlValues ' INCOLLA NOME FILTRATO
                                                        With .Range("A10:CZ10")
                                                            .AutoFilter ' disattiva il filtro (riga da aggiungere)
                                                            .AutoFilter Field:=6, Criteria1:=ws2.Range("A10")
                                                        End With
                                                        .Range("F10:F10000").SpecialCells(xlCellTypeVisible).End(xlDown).Offset(0, 14).Copy ' COPIA segno zodiacale
                                                        ws1.Range("B18").PasteSpecial Paste:=xlValues ' copia TELEFONO FILTRATO
                                                    End With
                                                    Application.CutCopyMode = False
                                                    Cancel = True
                                                    Me.Activate
                                                    Application.ScreenUpdating = True
                                                    
                                                    labf: 'da mettere dopo l'end if
                                                    
                                                    Set wb1 = Nothing
                                                    Set wb2 = Nothing
                                                    Set ws1 = Nothing
                                                    Set ws2 = Nothing
                                                    Set zona = Nothing
                                                    End Sub
                                                    • Questa risposta è stata modificata 8 mesi, 3 settimane fa da sid sid.
                                                  • Avatarteto21162
                                                    Partecipante
                                                      Post totali: 79

                                                      Grazie Sid,

                                                      tutto ok problema risolto

                                                      Teto :bye:

                                                    La discussione ‘[RISOLTO] Evitare salti di foglio’ è chiusa a nuove risposte.

                                                    Utilizzando il sito, accetti l'utilizzo dei cookie da parte nostra. maggiori informazioni

                                                    Questo sito utilizza i cookie per fornire la migliore esperienza di navigazione possibile. Continuando a utilizzare questo sito senza modificare le impostazioni dei cookie o cliccando su "Accetta" permetti il loro utilizzo.

                                                    Chiudi