Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

macro non più funzionante se spostata in personal

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

macro non più funzionante se spostata in personal

Postdi velieromatrix » 17/09/14 11:52

Buongiorno a tutti,
ho creato questa macro che se lanciata dalla cartella di lavoro funziona alla perfezione ma se copiata in un modulo in personal non funziona più.
Ovviamente il problema è di fargli "riconoscere" gli activeworkbook e l'altro da cui prelevare i dati... il problema è che non riesco a trovare la soluzione!!!

Codice: Seleziona tutto
Sub certificatiok()
Dim Cell
Dim X As String
Dim percorso As String, nome As String, nomecompleto As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

ActiveSheet.Range("A13:P130").Select
    Range("A13:P130").Activate
    ActiveSheet.Range("$A$13:$P$130").AutoFilter Field:=1, Criteria1:="<>", Operator:=xlFilterValues
    For Each Cell In Range("o14:O130").SpecialCells(xlCellTypeVisible)
X = "C:\Documents and Settings\fgiudice\Desktop\MASTERS\" & (Cell.Value) & ".xlsx"
Workbooks.Open Filename:=X, ReadOnly:=False

ActiveWorkbook.Sheets("Foglio1").Cells(5, 3) = Foglio1.Cells(4, 2)
ActiveWorkbook.Sheets("Foglio1").Cells(5, 4) = Foglio1.Cells(6, 2)
ActiveWorkbook.Sheets("Foglio1").Cells(5, 9) = Foglio1.Cells(7, 2) & " " & Foglio1.Cells(8, 2)
ActiveWorkbook.Sheets("Foglio1").Cells(54, 10) = Foglio1.Cells(2, 5)

ActiveWorkbook.Sheets("Foglio1").Cells(9, 3) = Foglio1.Cells(Cell.Row, 2)
ActiveWorkbook.Sheets("Foglio1").Cells(9, 4) = Foglio1.Cells(Cell.Row, 5)
ActiveWorkbook.Sheets("Foglio1").Cells(9, 7) = Foglio1.Cells(Cell.Row, 6)
ActiveWorkbook.Sheets("Foglio1").Cells(9, 9) = Foglio1.Cells(Cell.Row, 8)
ActiveWorkbook.Sheets("Foglio1").Cells(9, 10) = Foglio1.Cells(Cell.Row, 7)
ActiveWorkbook.Sheets("Foglio1").Cells(11, 3) = Foglio1.Cells(Cell.Row, 11)
ActiveWorkbook.Sheets("Foglio1").Cells(11, 7) = Foglio1.Cells(Cell.Row, 13)
ActiveWorkbook.Sheets("Foglio1").Cells(2, 11) = Foglio1.Cells(Cell.Row, 16)

percorso = ActiveWorkbook.Path & "\"
nome = (Cell.Value) & "_" & ActiveWorkbook.Sheets("Foglio1").Cells(9, 9).Value & ".xlsx"
nomecompleto = percorso & nome
   
ActiveWorkbook.SaveAs Filename:=nomecompleto
ActiveWorkbook.Close

Next Cell

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub


Grazie a chi vorrà aiutarmi a rendere utilizzabile la macro da ogni scheda aperta!!
velieromatrix
Newbie
 
Post: 7
Iscritto il: 15/09/14 16:55

Sponsor
 

Re: macro non più funzionante se spostata in personal

Postdi velieromatrix » 17/09/14 13:51

Può sembrarvi una soluzione efficace?
Codice: Seleziona tutto
Sub certificatiok()
Dim F As Workbook
Dim M
Dim Cell
Dim X As String
Dim percorso As String, nome As String, nomecompleto As String
Dim myWKBook
Dim newWKBook

Application.ScreenUpdating = False
Application.DisplayAlerts = False

myWKBook = ActiveWorkbook.Name
ActiveSheet.Range("A13:P130").Select
    Range("A13:P130").Activate
    ActiveSheet.Range("$A$13:$P$130").AutoFilter Field:=1, Criteria1:="<>", Operator:=xlFilterValues
    For Each Cell In Range("o14:O130").SpecialCells(xlCellTypeVisible)
X = "C:\Documents and Settings\fgiudice\Desktop\MASTERS\" & (Cell.Value) & ".xlsx"
Workbooks.Open Filename:=X, ReadOnly:=False
newWKBook = ActiveWorkbook.Name
Workbooks(newWKBook).Sheets("Foglio1").Cells(5, 3) = Workbooks(myWKBook).Sheets("Foglio1").Cells(4, 2)
Workbooks(newWKBook).Sheets("Foglio1").Cells(5, 4) = Workbooks(myWKBook).Sheets("Foglio1").Cells(6, 2)
Workbooks(newWKBook).Sheets("Foglio1").Cells(5, 9) = Workbooks(myWKBook).Sheets("Foglio1").Cells(7, 2) & " " & Workbooks(myWKBook).Sheets("Foglio1").Cells(8, 2)
Workbooks(newWKBook).Sheets("Foglio1").Cells(54, 10) = Workbooks(myWKBook).Sheets("Foglio1").Cells(2, 5)

Workbooks(newWKBook).Sheets("Foglio1").Cells(9, 3) = Workbooks(myWKBook).Sheets("Foglio1").Cells(Cell.Row, 2)
Workbooks(newWKBook).Sheets("Foglio1").Cells(9, 4) = Workbooks(myWKBook).Sheets("Foglio1").Cells(Cell.Row, 5)
Workbooks(newWKBook).Sheets("Foglio1").Cells(9, 7) = Workbooks(myWKBook).Sheets("Foglio1").Cells(Cell.Row, 6)
Workbooks(newWKBook).Sheets("Foglio1").Cells(9, 9) = Workbooks(myWKBook).Sheets("Foglio1").Cells(Cell.Row, 8)
Workbooks(newWKBook).Sheets("Foglio1").Cells(9, 10) = Workbooks(myWKBook).Sheets("Foglio1").Cells(Cell.Row, 7)
Workbooks(newWKBook).Sheets("Foglio1").Cells(11, 3) = Workbooks(myWKBook).Sheets("Foglio1").Cells(Cell.Row, 11)
Workbooks(newWKBook).Sheets("Foglio1").Cells(11, 7) = Workbooks(myWKBook).Sheets("Foglio1").Cells(Cell.Row, 13)
Workbooks(newWKBook).Sheets("Foglio1").Cells(2, 11) = Workbooks(myWKBook).Sheets("Foglio1").Cells(Cell.Row, 16)

percorso = Workbooks(newWKBook).Path & "\"
nome = (Cell.Value) & "_" & Workbooks(newWKBook).Sheets("Foglio1").Cells(9, 9).Value & ".xlsx"
nomecompleto = percorso & nome
   
ActiveWorkbook.saveas Filename:=nomecompleto
ActiveWorkbook.Close

Next Cell

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub
velieromatrix
Newbie
 
Post: 7
Iscritto il: 15/09/14 16:55

Re: macro non più funzionante se spostata in personal

Postdi Anthony47 » 21/09/14 22:57

Ciao velieromatrix, benvenuto nel forum.
Il problema e' l' uso dei Codename nelle istruzioni, es nelle righe del tipo
Codice: Seleziona tutto
ActiveWorkbook.Sheets("Foglio1").Cells(5, 3) = Foglio1.Cells(4, 2)     'Foglio1 e' un CodeName

Per definizione un codename fa riferimento al foglio del file che contiene la macro; da qui la necessita' di indicare in modo esplicito file e foglio Workbooks("IlNome").Sheets("IlFoglio"), come hai fatto con la seconda soluzione che hai pubblicato.
Se funziona va bene cosi', anche se:
-ti potevi risparmiare di indicare Workbooks(newWKBook)., perche' per definizione si fa riferimento al workbook attivo
-avresti postuto usare, invece di myWKBook = ActiveWorkbook.Name, la riga Set myWKBook = ActiveWorkbook.Sheets("Foglio1") e successivamente invece di Workbooks(myWKBook).Sheets("Foglio1").Cells(4, 2) usare myWKBook.Cells(4, 2)

Vale per le prossime volte.

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13894
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: macro non più funzionante se spostata in personal

Postdi velieromatrix » 25/09/14 08:13

Grazie mille!
Anche se nella prima stesura del codice avevo utilizzato ActiveWorkbook ma mi dava errore... :-?
velieromatrix
Newbie
 
Post: 7
Iscritto il: 15/09/14 16:55

Re: macro non più funzionante se spostata in personal

Postdi velieromatrix » 25/09/14 08:25

Approfitto per richiedere un ulteriore piccolo aiuto:
è possibile far creare una nuova cartella nella stessa posizione del file da cui lancio la macro e che sia nominata in base ad una cella in esso contenuta contando che questa macro devo "distribuirla" (so come si fa per creare nuovi file ma non cartelle...)?
Tra le altre cose c'è un modo per rendere "universale" la cartella dove trovo i vari master? Ora nel codice è così: "C:\Documents and Settings\mionome\Desktop\MASTERS\" quindi oltre a salvare la macro in personal dovrei poi andare a modificare l'indirizzo nel codice di ogni pc a cui ho distribuito la macro....
Grazie in anticipo per l'aiuto!
velieromatrix
Newbie
 
Post: 7
Iscritto il: 15/09/14 16:55

Re: macro non più funzionante se spostata in personal

Postdi Anthony47 » 25/09/14 14:21

Se per "Cartella" intendi una directory nel filesystem allora puoi partire da queste istruzioni:
Codice: Seleziona tutto
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set newFold = fso.CreateFolder(ThisWorkbook.Path & "New_Folder")
   NewFolderFull = newFold.Path      'solo dimostrativa
Ti trovi (se puo' servire nel prosieguo della macro) la nuova cartella assegnata all' oggetto "newFold"

Con queste istruzioni avrai invece nella variabile "DirDTop" l' indirizzo del desktop dell' utente attivo:
Codice: Seleziona tutto
    Set wshshell = CreateObject("WScript.Shell")
    DirDTop = wshshell.SpecialFolders("MyDocuments")
    Set wshshell = Nothing

Quindi invece di usare "C:\Documents and Settings\mionome\Desktop\MASTERS\" userai
DirTop & "\MASTERS"
oppure
DirTop & "\" Range("A1").Value

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13894
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: macro non più funzionante se spostata in personal

Postdi Anthony47 » 25/09/14 23:04

Un amico discreto mi ha fatto notare un paio di errori nel codice postato sopra:
1) This workbook.path restituisce un valore del tipo C:\Users\UTENTE\Documents, quindi non si deve usare (prima macro) ThisWorkbook.Path & "New_Folder" ma ThisWorkbook.Path & "\New_Folder"

2) Nella seconda macro, con SpecialFolders("MyDocuments") otterro' il path della cartella dei Documenti; se voglio quella del Desktop bisogna usare SpecialFolders("Desktop")

3) Poiche' il path e' messo nella variabile DirDTop, allora e' sbagliato successivamente usare una variabile DirTop che evidentemente sara' vuota.

Che dire... una performance abbastanza deludente...
Ciao!
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13894
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: macro non più funzionante se spostata in personal

Postdi velieromatrix » 26/09/14 16:45

Grazie mille la creazione della directory e DirDTop funzionano perfettamente (per il momento l'ho potuto testare solo sul mio pc a dire il vero!)

Vorrei affinare il for each... ma ho difficoltà con le istruzioni stile .End (xlToRight)...
in pratica la macro deve filtrare le righe che hanno un quantitativo in colonna 1 a partire dalla riga 14 poi prende il nome del master da aprire dalla cella O lo popola lo salva ecc e passa alla riga successiva (cosa che attualmente fa in maniera egregia) ma ad oggi quando arriva alla cella O vuota da errore io vorrei bloccare il loop prima che accada... mi date il LA?? Graziee!
velieromatrix
Newbie
 
Post: 7
Iscritto il: 15/09/14 16:55

Re: macro non più funzionante se spostata in personal

Postdi velieromatrix » 26/09/14 17:06

risolto con

Codice: Seleziona tutto
For Each Cell In Range("o15:o97").SpecialCells(xlCellTypeVisible)
 
If Cell.Value <> "" Then
velieromatrix
Newbie
 
Post: 7
Iscritto il: 15/09/14 16:55

Re: macro non più funzionante se spostata in personal

Postdi velieromatrix » 22/10/14 16:23

Ho notato che ogni file creato "resta nella memoria VBA" ovvero nei progetti mi ritrovo tutti i file creati benchè abbia aggiunto :
ActiveWorkbook.saveas Filename:=nomecompleto
ActiveWorkbook.Close
Set NOME = Nothing
Set newWKBook = Nothing

perchè non funziona il clean up?
Questo rallenta notevolmente la macro...
Grazie per le vs gentili risposte!
velieromatrix
Newbie
 
Post: 7
Iscritto il: 15/09/14 16:55

Re: macro non più funzionante se spostata in personal

Postdi Zer0Kelvin » 22/10/14 17:22

Ciao.
Non ho capito cosa intendi con
ogni file creato "resta nella memoria VBA" ovvero nei progetti mi ritrovo tutti i file creati

Comunque, bisognerebbe almeno vedere il codice completo delle macro coinvolte.
[Win7,Office2010]
Condividere la conoscenza aumenta la ricchezza di tutti(Z0°K)
Dai ad un uomo un pesce e lo avrai sfamato per un giorno;insegnagli a pescare e lo avrai sfamato per sempre(Confucio)
Il sonno della ragione genera mostri(Francisco Goya)
Avatar utente
Zer0Kelvin
Utente Senior
 
Post: 303
Iscritto il: 08/04/12 11:23


Torna a Applicazioni Office Windows


Topic correlati a "macro non più funzionante se spostata in personal":


Chi c’è in linea

Visitano il forum: patel e 9 ospiti