Sviluppare funzionalita su Microsoft Office con VBA Copiare 1 foglio da diverse cartelle in una nuova cartella

Login Registrati
Stai vedendo 12 articoli - dal 1 a 12 (di 12 totali)
  • Autore
    Articoli
  • #7614 Risposta

    bertu81
    Partecipante

      Buona sera a tutti.

      Sono qui a richiedere il vostro aiuto.

      Vorrei creare una macro che mi copia il foglio "x ASS.TEC." presente i tutte le cartelle.

      Prima di copiare  vorrei inserire tutti nella stessa cartella, il foglio è necessario applicare un filtro nella riga 9 dove la colonna C deve essere maggiore di 0.

      I file copiati li vorrei inserire in una nuova cartella.

      Grazie per l'auto prezioso!!

       

       

      #7616 Risposta

      vecchio frac
      Moderatore
        16 pts

        Non è che sei stato molto chiaro 🙂

        Inoltre la discussione è nuova, non ci sono riferimenti alla precedente e probabilmente chi legge il nuovo topic non ha file di riferimento da consultare.

        In sostanza:

        -allega un file su cui lavorare

        - descrivi meglio l'esigenza e il risultato da raggiungere

        😀

        #7639 Risposta

        bertu81
        Partecipante

          In allegato la serie di file contenenti i dati.

          In un nuovo file di Excel vorrei lanciare una macro:

          -per estrae dalle cartelle (in allegato) il foglio "x ASS.TEC." applicando un filtro alla riga 9 dove qualtità > 0,001, per ogni foglio un nuovo foglio

          -nominare i nuovi fogli della nuova cartella con il contenuto della cella C4

          -una volta finito di copiare i fogli stampa il pdf di tutta la cartella.

          non ho idea di dove partire.....

           

          Allegati:
          You must be logged in to view attached files.
          #7938 Risposta

          vecchio frac
          Moderatore
            16 pts

            Ecco scrivere qui è meglio così recuperiamo tutto il filo del discorso 🙂

            Noto che nei fogli "x ASS.TEC" c'è una protezione del foglio. Se possibile, ma devo verificare che lo sia, ti propongo di continuare con la tecnica già vista (creazione di un recordset ADO), piuttosto che di rimuovere la protezione da codice di volta in volta.

            Il resto è tutto fattibile. Per "stampa PDF di tutta la cartella" io capisco che in un unico file PDF vuoi riversare il contenuto delle schede ORDINE, BUDGET, x ASS. TEC. e VERIFICA x DOC. Se intendi escludere la pdf uno di questi fogli bisogna che lo dici 🙂

            Abbi un attimo di pazienza e appena posso mi dedico. Se vedi che passa troppo tempo e non hai risposta, fammi un richiamo in privato (non mi offendo, anzi).

            #7949 Risposta

            vecchio frac
            Moderatore
              16 pts

              Allora no, ho capito che vuoi estrarre il contenuto della scheda ORDINE (che in realtà è l'originale di quella riversata in x TEC ASS ma mi creano problemi le formule quindi pesco i dati da lì) di ogni file classe in un nuovo file, scheda classe per scheda classe, quindi ottenere un pdf unico.

              Ecco qui il codice che lo fa 🙂

              Option Explicit
              
              Private cn As Object
              Private rs As Object
              
              
              Sub make_pdf()
              Dim fso As Object
              Dim oFile As Object
              Dim p As Object
              Dim s As String
              Dim aborted As Boolean
              Dim c As Range
              Dim m As String
              Dim wb As Workbook
              Dim wbdest As Workbook
              Dim shdest As Worksheet
              Dim i As Long
                  
                  Set cn = CreateObject("ADODB.Connection")
                  Set rs = CreateObject("ADODB.Recordset")
                  
                  cn.Provider = "MSDASQL"
                  
                  Application.ScreenUpdating = False
                  
                     
                  'si può specificare un percorso iniziale ma si è vincolati a restare in questo path
                  'e non si può navigare tra le cartelle, quindi attenzione all'uso:
                  Set p = BrowseForFolder("Seleziona il percorso dove sono salvati i files:", ThisWorkbook.Path)
                  
                  Set wb = ThisWorkbook
                  Set wbdest = Workbooks.Add
                  
                  If p Is Nothing Then
                      MsgBox "Procedura annullata.", vbInformation
                      aborted = True
                  Else
                      Set fso = CreateObject("Scripting.FileSystemObject")
                      For Each oFile In fso.GetFolder(p.Self.Path).Files
                          If Right(oFile.Name, 3) Like "xls" Then
                          
                              s = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=%1; ReadOnly=False;"
                              s = Replace(s, "%1", oFile.Path)
                              cn.ConnectionString = s
                              cn.Open
                              
                              i = i + 1
                              If i > wbdest.Sheets.Count Then
                                  Set shdest = wbdest.Sheets.Add(after:=wbdest.Sheets(i - 1))
                              Else
                                  Set shdest = wbdest.Sheets(i)
                              End If
                              
                              Set rs = cn.Execute("SELECT * FROM [ordine$n5:n5]")
                              m = rs.fields(0).Name
                              shdest.Name = m
                              
                              Set rs = cn.Execute("SELECT descrizione, um, [quantità], [note] FROM [ordine$E1:K10000] WHERE [quantità]>0")
                                             
                              shdest.Range("A1:D1") = Split("Descrizione UM Q.TA NOTE ")
                              shdest.Cells(2, 1).CopyFromRecordset rs
                              
                              rs.Close
                              cn.Close
                          End If
                      Next
                  End If
                  
                  If aborted Then Exit Sub
                  
                  'ora crea il pdf nella stessa cartella
                  wbdest.ExportAsFixedFormat Type:=xlTypePDF, Filename:=wb.Path & "\x tec ass.pdf - tutte le classi.pdf"
                  
                  Application.ScreenUpdating = True
                  
                  Set rs = Nothing
                  Set cn = Nothing
                  Set oFile = Nothing
                  Set fso = Nothing
                  Set p = Nothing
                  
                  MsgBox "Fatto.", vbInformation
              
              End Sub
              
              
              
              Public Function BrowseForFolder(ByVal sPrompt As String, Optional ByVal start_path As Variant = "") As Object
              'alternative browseforfolder!
              'Usage:
              'Set s = BrowseForFolder("Seleziona la cartella:", "C:\defaultdir\")
              's contiene solo il nome della cartella selezionata
              's.Self.Path contiene il percorso completo della cartella selezionata
              
              Dim oShell As Object, oFolder As Object
              
              '     StartPath     A drive/folder path or one of the following numeric constants:
              '     DESKTOP = 0,      PROGRAMS = 2,      DRIVES = 17,      NETWORK = 18,
              '     NETHOOD = 19,     PROGRAMFILES = 38, PROGRAMFILESx86 = 48, Windows = 36
              
              'se non è stato specificato un percorso iniziale, parte dal desktop
                  If start_path = "" Then start_path = 0
                  Set oShell = CreateObject("shell.application")
                  Set oFolder = oShell.BrowseForFolder(0&, sPrompt, 0&, start_path)
                  If (Not oFolder Is Nothing) Then
                      Set BrowseForFolder = oFolder
                  End If
                  Set oFolder = Nothing
                  Set oShell = Nothing
              End Function

              Copialo in un modulo nuovo e richiamalo o associalo a un pulsante (la routine si chiama make_pdf).

              Il pdf risultante viene creato e salvato nella stessa cartella in cui si trova il file in cui hai copiato il codice.

              Magari allego la versione 4 del file su cui ho lavorato, tanto per completezza. Poi questo file andrebbe un po' ripulito, ci son delle cose da sistemare dentro (a livello di codice ma forse anche di fogli, che so magari il foglio x tec ass non ti serve più se fa tutto la macro leggendo il foglio ordine).

              Fai sapere eventuali problemi (spero di no).

               

              Allegati:
              You must be logged in to view attached files.
              #7964 Risposta

              bertu81
              Partecipante

                grazie! la macro funziona,  purtroppo non fa quello che intendevo io....

                Ti allego il pdf che vorrei far generare alla macro. (1 pagina per ordine contenente nome docente classe data)

                E' fattibile copiando dal foglio ordini? 

                Se è un problema la protezione del foglio "x ASS.TEC", potrei togliere la protezione e farlo diventare un foglio nascosta.

                GRAZIE per la disponibilità

                 

                non riesco ad allegare il pdf... ti ho fatto  Screenshot delle prime 2 pagine del pdf

                Allegati:
                You must be logged in to view attached files.
                #7969 Risposta

                vecchio frac
                Moderatore
                  16 pts

                  Bene, capito, e forse sì si può fare dalla scheda Ordine (devio riguardare un po' il tutto).

                  Magari la prox volta che fai lo screenshot evita di tirare dentro i messaggi di Whatsapp in arrivo, così tanto per la privacy   

                  #7974 Risposta

                  vecchio frac
                  Moderatore
                    16 pts

                    Riallego il file versione 5. Per comodità riporto anche il codice nella parte modificata:

                                    With shdest
                                        Set rs = cn.Execute("SELECT * FROM [ordine$n3:n3]")
                                        m = rs.fields(0).Name
                                        .Range("A2") = "DOCENTE"
                                        .Range("C2") = m
                                            
                                        Set rs = cn.Execute("SELECT * FROM [ordine$n5:n5]")
                                        m = rs.fields(0).Name
                                        shdest.Name = m
                                        .Range("A4") = "CLASSE"
                                        .Range("C4") = m
                                            
                                        Set rs = cn.Execute("SELECT * FROM [ordine$n7:n7]")
                                        m = rs.fields(0).Name
                                        .Range("A6") = "DATA ESERCITAZIONE"
                                        .Range("C6") = m
                                        
                                        .Range("A9:D9") = Split("Descrizione UM Q.TA NOTE ")
                                        
                                        Set rs = cn.Execute("SELECT descrizione, um, [quantità], [note] FROM [ordine$E1:K10000] WHERE [quantità]>0")
                                        .Cells(10, 1).CopyFromRecordset rs
                                                            
                                        'cosmetica
                                        .Range("A2:C2, A4:C4, A6:C6").Borders.LineStyle = xlContinuous
                                        .Range("A9").CurrentRegion.Borders.LineStyle = xlContinuous
                                    End With
                    

                    Ho aggiunto anche una parte di "cosmetica" che serve solo a mettere i bordi alle celle, tanto per farti capire che si possono anche formattare le celle come usuale prima di trasformare tutto in pdf. Ho recuperato i dati dal foglio "Ordine". Secondo me il foglio "x tec ass" si può eliminare, se era finalizzato solo a ottenere un pdf stampabile.

                    Allegati:
                    You must be logged in to view attached files.
                    #7977 Risposta

                    bertu81
                    Partecipante

                      Grazie!!! 

                      Dopo provo a testarla.

                      appena puoi, ti chiedo la cortesia di togliere le immagini del precedente post. (Con notifica whatsapp)

                      Grazie!!

                      #8035 Risposta

                      bertu81
                      Partecipante

                        Ho fatto un po’ di prove. 

                        La  Macri funziona 😃

                        grazie!!!

                        #8036 Risposta

                        bertu81
                        Partecipante

                          La  Macro funziona 😃 

                          il t9 ...

                           

                          #8038 Risposta

                          vecchio frac
                          Moderatore
                            16 pts

                            bertu81 wrote:funziona

                            Meno male 🙂 fai comunque altre prove. Vedrai che i bug saltano sempre fuori 😉

                          Login Registrati
                          Stai vedendo 12 articoli - dal 1 a 12 (di 12 totali)
                          Rispondi a: Copiare 1 foglio da diverse cartelle in una nuova cartella
                          Gli allegati sono permessi solo ad utenti REGISTRATI
                          Le tue informazioni:



                          vecchio frac - 591 risposte

                          albatros54
                          albatros54 - 507 risposte

                          Marius44
                          Marius44 - 270 risposte

                          patel
                          patel - 257 risposte

                          Luca73
                          Luca73 - 194 risposte

                          ChatBox per richiedere velocemente assistenza a semplici problematiche

                          Devi fare il login per scrivere nella chat

                          0
                          1