prelevare grande quantita di informazioni

[Avatar3]

No no
è solo un test se funzionava bene
si aggiusta il tiro per far in modo di rendere la macro universale
Ti potrei spiegare del perché ma evito visto che non ti interessa...
Modificare questo codice è semplicissimo se ti funziona così

[Anthony47]

La macro va in errore su quella istruzione perche' il file di partenza e' ancora protetto; infatti come ti ho messo le istruzioni l' unprotect lo fai sul file masa1.xls.
Sposta ActiveSheet.Unprotect prima della masopen = ckf("masa1.xls")

Ci sarebbero altre semplificazioni, ad esempio per non aprire e chiudere tre volte sto benedetto masa1.xls, ma al momento l' obiettivo e' farla girare.

Ciao

[raimea]

ok , ho sistemato il problm della protezione,
ora faccio un passa in avanti,
e si ferma qui :

Codice: Seleziona tutto

Application.CutCopyMode = False  '<<< toglie avviso di molti dati
If masopen = False Then ActiveWorkbook.Close SaveChanges:=False
Sheets("giornaliero").Select  <<< si blocca qui          e' il foglio dove deve incollare
Range("m7").Select  ' la cella dove incollare i dati

questo succede solo se masa1 e' gia aperto,
se e' chiuso preleva regolarmente.
grazie x la pazienza....

[Anthony47]

Allora, il messaggio che hai su quell' istruzione ti dice che quel nome foglio non esiste; se guardi excel (lasciando in debug la macro), vedrai che e' attivo il file masa1.xls, perche' alla riga precedente non e' stato chiuso; tu hai invece bisogno di selezionare il foglio "giornaliero" del file di partenza (in realta' questo bisogno nel frangente specifico non c' e', perche' non devi farci nulla, tant' e' che un paio di righe dopo selezionerai il foglio "1-masa1-Fogl.Base" su masa1.xls; ma la macro e' cosi').
Per aggirare, il mio suggerimento e' che dopo ogni If masopen = False Then ActiveWorkbook.Close SaveChanges:=False inserisci sempre

Codice: Seleziona tutto

ThisWorkbook.Activate

Pero'...
...pero' quando una lampadina non si accende ci provi da solo, vero??
Devi quindi imparare a debuggare il tuo codice, cioe' a capire perche' "nella circostanza" una cosa non ti funziona come ti aspetteresti e quindi poter rimediare; questo vuol dire eseguire il codice step-by-step, leggere il contenuto delle variabili, aggiungere o modificare istruzioni, mettere dei break, e altro ancora.
Trovi alcuni suggerimenti su come si fanno queste cose in questa discussione: viewtopic.php?p=378297

Il che non vuol dire che non vogliamo piu' darti una mano, ma solo che molte cose le puoi fare da solo molto piu' rapidamente.

Ciao

[Flash30005]

Approvo pienamente quanto detto da Anthony sul cercare di risolvere da soli
e seguire step-by-step il debug
perché vedendo direttamente gli "effetti" dei codici si acquisiscono molte nozioni

Avendo seguito il topic fin dall'inizio ho notato che l'esigenza di Raimea è quella di utilizzare il file Masa1.xls
e riportarlo allo stato originale (se era chiuso, tornare chiuso, se aperto rimanere aperto)

a tale scopo ho utilizzato il codice di Anthony aggiungendo una piccola modifica che permette di ottenere quanto richiesto, prova a testare la macro inserendo al posto del commento quanto occorre prima di "rilasciare" il foglio Masa1

Codice: Seleziona tutto

Public percorso, Nfile As String, FileC As Integer
Public masopen As Boolean
Function ckf(nomefile) As Boolean
For Each Wb In Workbooks
    If Wb.Name = nomefile Then
    FileC = 0
        ckf = True: Exit Function
    End If
Next Wb
End Function

Sub ApreFile()
FileC = 0
percorso = Application.ActiveWorkbook.Path
Nfile = "\" & "Masa1.xls"
masopen = ckf("Masa1.xls")
If masopen = False Then
FileC = 1
Application.Workbooks.Open percorso & Nfile
End If

'Inserire qui cosa devi farci con Masa1 e file con macro

If FileC = 1 Then Workbooks("Masa1.xls").Close savechanges:=False
End Sub


Ciao

[raimea]

finalmente funziona, preleva dal file sia che sia aperto che chiuso
e lo lascia come lo trova,
inoltre preleva giusto anche nel caso altri file excel siano aperti
questa la macro finale:

Codice: Seleziona tutto

Sub prel1()

Dim masopen As Boolean
ActiveSheet.Unprotect
masopen = ckf("masa1.xls") 'True=file gia' aperto


Application.ScreenUpdating = False
Application.Calculation = xlManual
 
   
percorso = Application.ActiveWorkbook.Path
Nfile = "\" & "masa1.xls"
If masopen = False Then Application.Workbooks.Open percorso & Nfile

Worksheets("1-masa1-Fogl.Base").Activate   ' <<< il foglio dove preleva
Range("c9:c1000").Copy
ThisWorkbook.Sheets("giornaliero").Range("m7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False  '<<< toglie avviso di molti dati
If masopen = False Then ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Sheets("giornaliero").Select
Range("m7").Select  ' la cella dove incollare i dati



masopen = ckf("masa1.xls") 'True=file gia' aperto

percorso = Application.ActiveWorkbook.Path
Nfile = "\" & "masa1.xls"
If masopen = False Then Application.Workbooks.Open percorso & Nfile
Worksheets("1-masa1-Fogl.Base").Activate   ' <<< il foglio dal quale preleva
Range("l9:l1000").Copy
ThisWorkbook.Sheets("giornaliero").Range("n7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False  '<<< toglie avviso di molti dati
If masopen = False Then ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Sheets("giornaliero").Select
Range("n7").Select  ' la cella dove incollare i dati


masopen = ckf("masa1.xls") 'True=file gia' aperto

percorso = Application.ActiveWorkbook.Path
Nfile = "\" & "masa1.xls"
If masopen = False Then Application.Workbooks.Open percorso & Nfile

Worksheets("1-masa1-Fogl.Base").Activate   ' <<< il foglio dove preleva
Range("n9:n1000").Copy
ThisWorkbook.Sheets("giornaliero").Range("o7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False  '<<< toglie avviso di molti dati
If masopen = False Then ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Sheets("giornaliero").Select
Range("o7").Select  ' la cella dove incollare i dati

 Columns("n:o").EntireColumn.AutoFit  ' adatta la larghezza colonna al contenuto
        Cells.Rows.AutoFit
         
         Columns("p:p").ColumnWidth = 3
         
 ActiveWindow.DisplayGridlines = False
   
Range("m65536").End(xlUp).Offset(1, 0).Select  ' vai alla prima cella libera di col u

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering _
        :=True
       
        Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
       

End Sub

uso il debug tasti f8 e f9, .. e meno male che ci sono.
ma sono sincero, quando premo il punto ? per risolvere un debug
con la giuda on linee faccio molta, molta, molta fatica a capire cosa mi sta dicendo...

ora della macro sopra sto tentando di prelevare da masa1 - senza aprilo 3 volte ma
ho gia fatto penso un 100naio di prove e x il momento sono...... nel buio....
comunque grazie a tutti e 3 per il sostegno...

[Anthony47]

Bravo...
Quando debuggo non clicco mai il "?"; leggo il messaggio, guardo l' istruzione, guardo il file, guardo il contenuto delle variabili e in genere non e' necessarioi fare tutte queste cose per capire il problema.

Per pura curiosita', adesso che l' hai fatta funzionare, prova questa variante di macro:

Codice: Seleziona tutto

Sub prel1()
Dim masopen As Boolean, SecWb As String
'
SecWb = "masa1.xls"
ActiveSheet.Unprotect
masopen = ckf(SecWb) 'True=file gia' aperto
'
Application.ScreenUpdating = False
Application.Calculation = xlManual
'
percorso = Application.ActiveWorkbook.Path
'Nfile = "\" & "masa1.xls"
If masopen = False Then Application.Workbooks.Open percorso & "\" & SecWb
Worksheets("1-masa1-Fogl.Base").Range("c9:c1000").Copy   ' <<< il foglio dove preleva
'Range("c9:c1000").Copy
ThisWorkbook.Sheets("giornaliero").Range("m7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'Application.CutCopyMode = False  '<<< toglie avviso di molti dati
'If masopen = False Then ActiveWorkbook.Close savechanges:=False
'ThisWorkbook.Activate
'Sheets("giornaliero").Select
'Range("m7").Select  ' la cella dove incollare i dati



'masopen = ckf("masa1.xls") 'True=file gia' aperto

'percorso = Application.ActiveWorkbook.Path
'Nfile = "\" & "masa1.xls"
'If masopen = False Then Application.Workbooks.Open percorso & Nfile
Workbooks(SecWb).Worksheets("1-masa1-Fogl.Base").Range("l9:l1000").Copy   ' <<< il foglio dal quale preleva
'Range("l9:l1000").Copy
ThisWorkbook.Sheets("giornaliero").Range("n7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'Application.CutCopyMode = False  '<<< toglie avviso di molti dati
'If masopen = False Then ActiveWorkbook.Close savechanges:=False
'ThisWorkbook.Activate
'Sheets("giornaliero").Select
'Range("n7").Select  ' la cella dove incollare i dati

'masopen = ckf("masa1.xls") 'True=file gia' aperto

'percorso = Application.ActiveWorkbook.Path
'Nfile = "\" & "masa1.xls"
'If masopen = False Then Application.Workbooks.Open percorso & SecWb

Workbooks(SecWb).Worksheets("1-masa1-Fogl.Base").Range("n9:n1000").Copy   ' <<< il foglio dove preleva
'Range("n9:n1000").Copy
ThisWorkbook.Sheets("giornaliero").Range("o7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False  '<<< toglie avviso di molti dati
If masopen = False Then ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Sheets("giornaliero").Select
'Range("o7").Select  ' la cella dove incollare i dati

Columns("n:o").EntireColumn.AutoFit  ' adatta la larghezza colonna al contenuto
Cells.Rows.AutoFit
Columns("p:p").ColumnWidth = 3
ActiveWindow.DisplayGridlines = False
Range("m65536").End(xlUp).Offset(1, 0).Select  ' vai alla prima cella libera di col u
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering _
        :=True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


E' probabile che faccia le cose che cerchi, aprendo una sola volta masa1; tutte le righe con l' apostrofo in testa sono inutili, le ho lasciate solo per farti vedere le differenze poi le puoi eliminare.

Per Flash:
perdona, ma con la variante proposta qui: viewtopic.php?f=26&t=90580&start=40#p526692 hai solo ottenuto di dover usare, con due macro, questa sintassi
If FileC = 1 Then Workbooks("Masa1.xls").etc etc
invece di quella originale
If masopen = False Then Application.Workbooks.Open.etc etc
Huummm....

Ciao!

[raimea]

compito eseguito....
questa la macro finale che apre 1na sola volta il file masa1,
per poi prelevare 3 dati diversi nello stesso file.

Codice: Seleziona tutto

Sub prel1()
Dim masopen As Boolean, SecWb As String

Inizio = Timer

SecWb = "masa1.xls"
ActiveSheet.Unprotect
masopen = ckf(SecWb) 'True=file gia' aperto
'
Application.ScreenUpdating = False
Application.Calculation = xlManual
'
percorso = Application.ActiveWorkbook.Path
If masopen = False Then Application.Workbooks.Open percorso & "\" & SecWb

Worksheets("1-masa1-Fogl.Base").Range("c9:c1000").Copy   ' <<< il foglio dove preleva
ThisWorkbook.Sheets("giornaliero").Range("m7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Workbooks(SecWb).Worksheets("1-masa1-Fogl.Base").Range("l9:l1000").Copy   ' <<< il foglio preleva
ThisWorkbook.Sheets("giornaliero").Range("n7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False


Workbooks(SecWb).Worksheets("1-masa1-Fogl.Base").Range("n9:n1000").Copy   ' <<< il foglio dove preleva
ThisWorkbook.Sheets("giornaliero").Range("o7").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False  '<<< toglie avviso di molti dati
If masopen = False Then ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Sheets("giornaliero").Select

Columns("n:o").EntireColumn.AutoFit  ' adatta la larghezza colonna al contenuto
Cells.Rows.AutoFit
Columns("p:p").ColumnWidth = 3
ActiveWindow.DisplayGridlines = False
Range("m65536").End(xlUp).Offset(1, 0).Select  ' vai alla prima cella libera di col u
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFiltering _
        :=True
       
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Fine = Timer
MsgBox ("Tempo impiegato " & Int((Fine - Inizio) / 60) & " min " & (Fine - Inizio) Mod 60 & " Sec")

End Sub

la macro e' molto piu "magra"...
alla fine sono state piu le righe tolte ,di quelle che rimangono...

1.000 grazie ancora.
ciao