Ciao Maurizio,
=============
Post by Norman JonesApprofitto, per suggerire che si possa
rendere la tua routine più robusta se si
gestisse, esplicitamente. l'errore che si
incontrerebbe se, per qualunque motivo,
il primo foglio fosse privo di dati.
Robusta e` robusta, direi. Ma forse tu e io intendiamo il termine
"robusta" in modo diverso. Tu perche' definisci "poco robusta" quella
routine?
Post by Norman Jonesse si
gestisse, esplicitamente. l'errore che si
incontrerebbe se, per qualunque motivo,
il primo foglio fosse privo di dati.
Non saprei... Mi sembra in parte eccessivo perche' cosi` com`e` la
routine in tal caso si interrompe segnalando un errore generico e
l'utente si ritrova aperta la Cartella di lavoro che ha causato
l`errore.
Sta cosi` a lui decidere che fare, se eliminare tale Cartella di lavoro
dalla Cartella (Folder) oppure rimediare aggiungendo gli eventuali dati
mancanti.
Se invece l'elaborazione proseguisse, escludendo tale Cartella di lavoro
e le eventuali altre con lo stesso problema, si otterrebbe un risultato
che potrebbe anche essere inutile in quanto da rifare e si dovrebbe
emettere al termine una lista delle Cartella di lavoro non rispondenti
ai requisiti.
Questa mi sembra una complicazione inutile, in molte circostanze.
Insomma, quello che dici e` giusto ma per valutare il comportamento da
tenere io prima vorrei essere informato piu` in dettaglio riguardo` la
realta` nella quale tale routine viene impiegata, la frequenza d'uso, il
flusso di lavoro, in una parola... lo scopo.
=============
Per piu' robusta, intendo - in questo
caso - che si gestica l'errore prevedibile
in modo che l'utente sappia il motivo per
il problema - anzichè vedesse un messagio
di errore generico. Inoltre, preferirei che,
armato con questa informazione, l'utente
possa decidere di continure, ignorando
l'assenza dei dati, oppure di cancellare la
routine. In quest'ultimo caso prevederei
che la tua routine cancellasse il nuovo
foglio e chiudesse il workbook
problematico.
Per ottenere questa funzionalita', si
richiederebbe soltanto una leggera
modifica della tua routine; ad esempio:
'========>>
Option Explicit
Public Sub TuttiPerUno()
On Error GoTo ErrorHandler
Const cWbExt = "*.xls"
Const cWshIndex = 1
Dim strPathSep As String
Dim strPathName As String
Dim strMyName As String
Dim strFilename As String
Dim wbIn As Excel.Workbook
Dim wshIn As Excel.Worksheet
Dim wshOut As Excel.Worksheet
Dim rngOut As Excel.Range
Dim rCell As Excel.Range
Dim Res As VbMsgBoxResult
With Application
.ScreenUpdating = False
.DisplayAlerts = False
strPathSep = .PathSeparator
With .ThisWorkbook
strPathName = .Path
strMyName = .Name
With .Worksheets
Set wshOut = .Add(Before:=.Item(1))
End With
End With
End With
If Right$(strPathName, 1) <> strPathSep Then
strPathName = strPathName & strPathSep
End If
strPathName = strPathName
strFilename = Dir(strPathName & cWbExt, vbNormal)
Do While Len(strFilename)
If strFilename <> strMyName Then
'Debug.Print strFilename
Set wbIn = Workbooks.Open(strPathName & strFilename _
, ReadOnly:=True _
, AddToMru:=False)
'Debug.Print , wbIn.FullName
Set wshIn = wbIn.Worksheets.Item(cWshIndex)
'Debug.Print , , wshIn.Name
With wshOut.UsedRange
If .Rows.Count = 1 Then
Set rngOut = .Cells(1, 1)
Else
Set rngOut = .Resize(1 _
, 1).Offset(.Rows.Count)
End If
With wshIn.Cells
Set rCell = .Find("*" _
, After:=.Cells(1, 1) _
, LookIn:=xlFormulas _
, LookAt:=xlPart _
, SearchOrder:=xlByRows _
, SearchDirection:=xlPrevious _
, MatchCase:=False)
If Not rCell Is Nothing Then
.Range(.Item(1, 1), rCell).Copy _
Destination:=rngOut
Else
Res = MsgBox(Prompt:="Il foglio " _
& .Parent.Name _
& " del workbook " _
& wbIn.Name _
& " non ha dati, vuoi
continuare?", _
Buttons:=vbCritical + vbYesNo, _
Title:="Continare?")
If Res = vbNo Then
Application.DisplayAlerts = False
wshOut.Delete
Application.DisplayAlerts = True
wbIn.Close Savechanges:=False
Exit Sub
Else
'\\ Continuiamo, ignorando il workbook
'\\ senza dati!
End If
End If
End With
End With
wbIn.Close Savechanges:=False
End If
strFilename = Dir
Loop
ExitProcedure:
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
Set rCell = Nothing
Set rngOut = Nothing
Set wshOut = Nothing
Set wshIn = Nothing
Set wbIn = Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbCritical
Resume ExitProcedure
End Sub
'<<========
Che tale funzionalita sia utile è' piuttosto
una questione di gusto ed opinione: le mie
osservazioni non sono state intese come
critica ma come commento costruttivo e
come l'espressione di un altro punto di
vista.
=============
A me invece di quella routine non piace il fatto che stia nel Progetto
VBA di una Cartella di lavoro salvata nella stessa Cartella (Folder) in
cui si trovano i file. Preferirei tenere separati il file-risultato e i
file da fondere in uno.
=============
Concordo pienamente.
Saluti!
---
Regards.
Norman