![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(128, 8%, 22%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3EA%3C/text%3E%3C/svg%3E)
Microsoft 365 e Office | Excel | Per la casa | Windows
Una famiglia di software per fogli di calcolo Microsoft con strumenti per l'analisi, la creazione di grafici e la comunicazione dei dati.
Ciao Francesco,
Solo un'ultima domanda e una curiosità.
- La domanda: quando parte la macro "Step_2", correttamente toglie la protezione al foglio e la rimette. Quando la rimette, però, non è più possibile usare i filtri sulla riga 1. C'è un modo per selezionare alcune opzioni quando si reinserisce la password (ecco uno screenshot)?
Sostituisci la procedura Step_2 con la seguente versione, in cui la modifica è evidenziata in verde
'========>>
Option Explicit
'-------->>
Public Sub Step_2()
Dim WB\_Inviati As Workbook, WB\_Testo As Workbook
Dim SH\_Report As Worksheet, SH\_Confronto As Worksheet
Dim SH\_Inviati As Worksheet
Dim Rng\_Inviati As Range
Dim sPath As String, sSeparatore As String
Const sPercorso As String = **"C\CARTELLA\" ' '<<=== Modifica**
Const sFoglio\_Report As String = **"Report"**
Const sFoglio\_Confronto As String = **"Confronto"**
Const sFoglio\_Inviati As String = **"Foglio1"**
Const sFile\_Inviati As String = **"Inviati"**
Const sFile\_Testo As String = **"ElencoCartelle.txt"**
Const sPassword As String = **"Password" '<<=== Modifica**
sSeparatore = Application.PathSeparator
If Right(sPercorso, 1) = sSeparatore Then
sPath = sPercorso
Else
sPath = sPercorso & sSeparatore
End If
With ThisWorkbook
Set SH\_Report = .Sheets(sFoglio\_Report)
Set SH\_Confronto = .Sheets(sFoglio\_Confronto)
End With
On Error GoTo XIT
Application.ScreenUpdating = False
SH\_Confronto.UsedRange.ClearContents
SH\_Report.Unprotect Password:=sPassword
'\\ IMPORTA FILE TXT
Workbooks.OpenText Filename:=sPath & sFile\_Testo, \_
Origin:=xlWindows, StartRow:=6, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 9), Array(10, 9), Array(21, 9), Array(36, 1)), TrailingMinusNumbers:=True
Set WB\_Testo = ActiveWorkbook
With WB\_Testo
.Sheets(1).Columns("A:A").Copy Destination:=SH\_Confronto.Range("A1")
.Close SaveChanges:=False
End With
'\\ COPIA-INCOLLA DA FILE DI LEASYS
Set WB\_Inviati = Workbooks.Open(Filename:=sPath & sFile\_Inviati)
Set SH\_Inviati = WB\_Inviati.Sheets(sFoglio\_Inviati)
Set Rng\_Inviati = SH\_Inviati.Range("A1").CurrentRegion
Rng\_Inviati.Copy Destination:=SH\_Report.Range("A1")
WB\_Inviati.Close SaveChanges:=False
Call MsgBox(Prompt:="Fatto", Buttons:=vbInformation, Title:="REPORT")
XIT:
Application.ScreenUpdating = True
SH\_Report.Protect Password:=sPassword**, DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True**
End Sub
'<<========
- La curiosità: vorrei aggiungere nell'oggetto dell'email (COLONNA J del file "Aggregato") la data (Colonna C del file "Aggregato"). Come posso fare? Ci ho provato più volte ma restituisce sempre il formato tipo 44599...
Nella procedura Step_3, sostituisci l'istruzione:
.Subject = arrIn(i, 10)
con:
.Subject = arrIn(i, 10) **& Space(1) & "Data: " & Format(arrIn(i, 3), "dd/mm/yyyy")**
Nota bene:
Vista la prima richiesta di cui sopra, nella funzione LastRow del modulo di codice Modulo 1, sarà necessario sostituire l'istruzione
SH.Protect Password:=sPassword, UserInterfaceOnly:=True
con:
SH.Protect Password:=sPassword, UserInterfaceOnly:=True, DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
===
Regards,
Norman