You are here:Home-Domande su Excel VBA e MACRO-[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

Visualizzazione 23 filoni di risposte
  • Autore
    Post
    • Avatarteto21162
      Partecipante
        Post totali: 88

        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 topic è stato modificato 1 anno, 3 mesi fa da Avatarteto21162.
        • Questo topic è stato modificato 1 anno, 3 mesi fa da sidsid.
      • Avatarteto21162
        Partecipante
          Post totali: 88

          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: 88

              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: 88

              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: 749

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

              • Avatarteto21162
                Partecipante
                  Post totali: 88

                  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: 88

                    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: 88

                      Ciao Sid,

                      sono utili i file che ti ho postato :bye:

                      Teto

                    • sidsid
                      Moderatore
                        Post totali: 749

                        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: 88

                          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 1 anno, 3 mesi fa da Avatarteto21162.
                        • sidsid
                          Moderatore
                            Post totali: 749

                            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: 88

                              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: 749

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

                              • Avatarteto21162
                                Partecipante
                                  Post totali: 88

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

                                • Avatarteto21162
                                  Partecipante
                                    Post totali: 88

                                    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: 749

                                      Questi sono i file che ho

                                    • Avatarteto21162
                                      Partecipante
                                        Post totali: 88

                                        Ciao Sid,

                                        prepara i file non è mio

                                        prova a riscaricare dal mio post

                                        Teto

                                      • Avatarteto21162
                                        Partecipante
                                          Post totali: 88

                                          Per tagliare la testa al toro ti ricarico i file

                                          <br />

                                           

                                          <br />

                                        • Avatarteto21162
                                          Partecipante
                                            Post totali: 88

                                            ok provato a scaricare funziona i file sono esattamente quelli

                                            Teto

                                          • sidsid
                                            Moderatore
                                              Post totali: 749

                                              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: 88

                                                ok grazie mille del consiglio ora ci provo

                                                Teto :good:

                                              • Avatarteto21162
                                                Partecipante
                                                  Post totali: 88

                                                  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: 749

                                                    Appena posso ti dò una mano

                                                  • sidsid
                                                    Moderatore
                                                      Post totali: 749

                                                      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 1 anno, 3 mesi fa da sidsid.
                                                    • Avatarteto21162
                                                      Partecipante
                                                        Post totali: 88

                                                        Grazie Sid,

                                                        tutto ok problema risolto

                                                        Teto :bye:

                                                    Visualizzazione 23 filoni di risposte
                                                    • Il topic ‘[RISOLTO] Evitare salti di foglio’ è chiuso a nuove risposte.