-
Articoli
-
PDACiao a tutti,con i codici sotto riportati riesco a creare i file "codice cliente.xlsx" dei SOLI codici clienti COMUNI ai fogli PREZZI ed ESTRATTI CONTO, salvandoli sul desktop (macro presente nel Modulo 6).Con la funzione (Modulo 7) allego i file di cui sopra alla specifica mail proprio di quel codice cliente.Public Function bFound1() As Variant Dim rAgenti As Range, Cella As Range, totAgenti As Range Dim Shc As Worksheet, Shc1 As Worksheet Dim uR As Long, ur1 As Long Dim myItem As Variant Application.ScreenUpdating = False Set Shc = ThisWorkbook.Sheets("Estratti Conto") Set Shc1 = ThisWorkbook.Sheets("PREZZI") uR = Shc.Range("A" & Rows.Count).End(xlUp).Row ur1 = Shc1.Range("G" & Rows.Count).End(xlUp).Row Set rAgenti = Shc1.Range(Shc1.Cells(8, 7), Shc1.Cells(ur1, 7)) 'Foglio PREZZI Set totAgenti = Shc.Range(Shc.Cells(2, 1), Shc.Cells(uR, 1)) 'Foglio ESTRATTI CONTO On Error Resume Next For Each myItem In rAgenti bFound = False For Each Cella In totAgenti If Cella.Value = CLng(myItem) Then bFound = True End If Next Cella Next myItem Set Cella = Nothing Set Shc = Nothing Set Shc1 = Nothing Application.ScreenUpdating = True End FunctionIl grosso problema che sto trovando è che con la seguente istruzione:
If bFound1(Riga) Then
.Attachments.Add (Environ("USERPROFILE") & "\Desktop\" & "Archivio\" & (Foglio1.Cells(Riga, 7).Value & ".xlsx"))
.HTMLBody = Trim(Foglio4.Cells(24, 5)) & accapo & accapo & aStr & accapo & accapo & .HTMLBody
Else
.HTMLBody = aStr & accapo & accapo & .HTMLBodyEnd Ifnon riesco ad inserire l'avviso presente nell'apposito foglio (AVVISI) SOLO per le mail che hanno l'allegato "codice cliente.xlsx" (altre mail hanno un altro tipo di allegato) e non a tutte le mail in uscita.
Qualcuno potrebbe aiutarmi?
Grazie mille.
Saluti,
PDAPS Questo è il link dove ho inserito il file di prova:
CiaoIl file è molto complesso. Fra l'altro non dici quale è il "grosso problema".Nella riga di codice indicata il problema sorge ogni volta che c'è un If bFound1(Riga) Then oppure in una specifica riga?Tuttavia, se ho visto bene, il problema potrebbe essere nel Nome del Foglio dal quale vuoi attingere la frase.Quando nel codice c'è Foglio4.Cells(24, 5) il programma si inceppa perchè non trova il Foglio4 (non mi sembra di aver notato un tale Foglio).Sei certo di aver indicato il Foglio esatto?E' una mia supposizione in quanto non posso lanciare la macro per mancanza di altri riferimenti.Fai sapere. Ciao,MarioTuttavia, se ho visto bene, il problema potrebbe essere nel Nome del Foglio dal quale vuoi attingere la frase.Quando nel codice c’è Foglio4.Cells(24, 5)prova ha sostituire"foglio4"; con "sheets("AVVISI")Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente?( Alan Turing)
PDASalve signori,scusatemi per il ritardo nella risposta, ma non ho ricevuto alcuna notifica dei vostri post.Per fortuna (mia) mi sono connesso ora ed ho letto.Non ho un problema di inceppamento, perché credo di aver settato in modo corretto il riferimento:Set Foglio4 = ActiveWorkbook.Worksheets("AVVISI")Piuttosto il mio problema è questo:riesco ad allegare alle mail gli estratti conto prodotti in precedenza, e solo, come giusto che sia, per quei codici clienti per i quali ci sono estratti conto da elaborare.Ma ci sono anche clienti che invece non hanno estratti conto da generare, per cui è corretto che non ci sia alcun allegato alla loro mail. E ciò avviene correttamente.L'avviso presente nel foglio AVVISI deve essere inserito SOLO nelle mail di quei clienti che hanno l'estratto conto in allegato.Le macro che ho postato, soprattutto la seconda, non risponde perfettamente a questo compito, perché riporta il suddetto avviso in tutte le mail, anche per questi clienti che NON hanno alcun estratto conto generato.Spero di aver spiegato meglio il mio problema.Attendo con grande impazienza.Grazie mille.Saluti,PDAAnche a me non piace la rigaSet Foglio4 = ActiveWorkbook.Worksheets(“AVVISI”), non costa nulla seguire il consiglio di Albatros o cambiare nome alla variabile, per esSet Avvisi = ActiveWorkbook.Worksheets(“AVVISI”)
PDACiao Patel,non capisco perché non ricevo le notifiche delle vostre risposte.Comunque ho provato a cambiare il nome, ma il risultato non cambia purtroppo.Saluti,PDAsicuramente non ricevi le notifiche perchè non ti sei registrato
Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente?( Alan Turing)
Appena registrato. Credevo che la spunta qui in basso fosse sufficiente.Saluti,PDAHo scaricato il file allegato, ho modificato il nome utente e cliccato sul pulsante, gira perfettamente, non capisco qual'è il problema.Ciao Patel,scusami per il ritardo nel riscontro. Spero di riuscire a spiegare il mio problema nel modo più esauriente possibile.La macro produce 9 mail che partono tutte almeno con un allegato.SOLO le prime 3 hanno 2 allegati (un estratto conto "codcli.xlsx" + Modulo Ordini - o comunque un qualsiasi altro file sul tuo pc).Le altre mail hanno un solo allegato: la quarta e quinta hanno solo il file Modulo Ordini ed il resto solo l'estratto conto "codcli.xlsx".Il mio problema è proprio sulla quarta e quinta mail, perché noterai che viene riprodotto sempre lo stesso messaggio (foglio AVVISI (24, 5)).Per una questione di precisione, ritengo che questo messaggio non debba essere riportato nelle mail che non hanno in allegato l'estratto conto.Ti prego di farmi sapere se sono stato abbastanza esaustivo.Grazie mille per il tempo che mi stai dedicando.Saluti,PDAhai allegato un file con molti moduli e molti fogli senza spiegare come il tutto funziona, io clicco sul pulsante verde e vedo creare una cartella con dei file, non avendo io outlook installato dovrebbe dare errore e non lo fa. Come vedi nessuno ti risponde perché non ha voglia di diventar matto a capireQuello è il file originario e nel mio primo post ho indicato i moduli di riferimento, con anche il codice relativo.Il mio progetto è molto complesso e nel corso degli anni si è sviluppato sempre di più.A questo punto credo che il problema sia nella funzione al modulo 7, che non gira a dovere...Saluti,PDACiao Patel,sto provando a fare un altro tipo di approccio al problema.Sto cercando di modificare il codice al Modulo 6, che è quello che mi consente di creare i file con nome dato dal codice numerico del cliente e l'estensione .xlsx.Ho scritto un'istruzione:uR3 = Shc1.Range("AD" & Rows.Count).End(xlUp).Row
Set rAgenti2 = Shc1.Range(Shc1.Cells(8, 30), Shc1.Cells(uR3, 30)) 'Foglio PREZZI colonna ADMa non riesco a capire dove inserire quest'altra istruzione:rAgenti2.Value = "X"Il mio scopo adesso è quello di fare in modo che nella colonna AD del foglio PREZZI venga inserita una "X" SOLO in corrispondenza di quei codici clienti per i quali è stato generato il file.Il riscontro credo sia più veloce e semplice rispetto a prima.Bisogna considerare solo i moduli 6 (EstraiFile) e 7 (funzione bFound).Il codice principale si trova al Foglio1 (PREZZI), ma in questa fase non occorre analizzarlo poiché è sufficiente che la macro giri fino alla generazione dei file per poter verificare se la "X" viene inserita in modo corretto.Il problema che ho riscontrato è che, per come ho inserito le due istruzioni sopra riportate, la "X" appare dalla riga 1 in poi.Public Sub EstraiFile()Dim Elenco As Collection
Dim Agente As Variant
Dim rAgenti As Range, Cella As Range, totAgenti As Range, rAgenti2
Dim Shc As Worksheet, Shc1 As Worksheet, Shc2 As Worksheet
Dim NewWK As Workbook
Dim sRigaBis As Long, uR As Long, ur1 As Long
Dim myItem As Variant
Dim bFound As Boolean
Dim uR2 As Long, iR As Long, uR3 As Long
Dim iStart As Long, iEnd As Long
Dim Expire As BooleanApplication.ScreenUpdating = False
Set Elenco = New Collection
Set Shc = ThisWorkbook.Sheets("Estratti Conto")
Set Shc1 = ThisWorkbook.Sheets("PREZZI")
uR = Shc.Range("A" & Rows.Count).End(xlUp).Row
ur1 = Shc1.Range("G" & Rows.Count).End(xlUp).Row
Set rAgenti = Shc1.Range(Shc1.Cells(8, 7), Shc1.Cells(ur1, 7)) 'Foglio PREZZI colonna G
Set totAgenti = Shc.Range(Shc.Cells(2, 1), Shc.Cells(uR, 1)) 'Foglio ESTRATTI CONTOuR3 = Shc1.Range("AD" & Rows.Count).End(xlUp).Row
Set rAgenti2 = Shc1.Range(Shc1.Cells(16, 30), Shc1.Cells(uR3, 30)) 'Foglio PREZZI colonna ADOn Error Resume Next
For Each Agente In rAgenti 'per ciascun codice agente del foglio Prezzi
If Agente.Value <> "" Then
Elenco.Add Agente.Value 'aggiungilo ad Elenco
'rAgenti2.Value = "X"
Else: Agente = Agente + 1
End If
Next AgenteOn Error Resume Next
MkDir (Environ("USERPROFILE") & "\Desktop\" & "Archivio")
On Error GoTo 0
For Each myItem In Elenco
bFound = False
sRigaBis = 2
For Each Cella In totAgenti
If Cella.Value = CLng(myItem) Then
If bFound = False Then
Set NewWK = Workbooks.Add
With NewWK.Sheets(1)
.Range("A1:K1").Value = Array( _
"Codice Cliente", "Ragione Sociale", "Tipo di Documento", _
"Data Emissione", "Data Scadenza Fattura", _
"Giorni di Ritardo", "Tipo di Fattura", "Numero di Fattura", _
"Riferimento", "Importo in €", "TOTALE")
.Range("A1:K1").Select
End With
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End WithSelection.AutoFilter
Range("A2").Select
ActiveWindow.FreezePanes = TrueRows("1:1").Select
Selection.Locked = False
Selection.FormulaHidden = FalseWith Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End WithSelection.RowHeight = 32.25
Columns("A:A").ColumnWidth = 9.86
Columns("B:B").ColumnWidth = 11.71
Columns("C:C").ColumnWidth = 8.86
Columns("C:C").ColumnWidth = 11
Columns("D:D").ColumnWidth = 12.43
Columns("E:E").ColumnWidth = 16.86
Columns("E:E").ColumnWidth = 14.29
Columns("F:F").ColumnWidth = 9.71
Columns("G:G").ColumnWidth = 8.86
Columns("H:K").ColumnWidth = 15End If
bFound = True
Cella.EntireRow.Copy NewWK.Sheets(1).Cells(sRigaBis, 1)
sRigaBis = sRigaBis + 1
End If
Next CellaNewWK.Sheets(1).Range("A1").Select
NewWK.Sheets(1).Columns("B:B").EntireColumn.AutoFitIf bFound Then
Call InserisciTotali
On Error Resume Next
Application.DisplayAlerts = FalseNewWK.SaveAs Filename:=(Environ("USERPROFILE") & "\Desktop\" & "Archivio\" & myItem)
Application.DisplayAlerts = True
NewWK.Close'rAgenti2.Value = "X"
End If
Next myItem
'rAgenti2 = rAgenti2 + 1If bFound Then
rAgenti2.Value = "X"
End IfSet NewWK = Nothing
Set Elenco = Nothing
Set Cella = Nothing
Set Shc = Nothing
Application.ScreenUpdating = TrueEnd Sub
Mentre invece dovrebbe essere inserita a partire dalla riga 8 e SOLO per quei codici che generano il file "codicecliente.xlsx".Credi sia più fattibile questa strada?Attendo tue gradite notizie.Grazie mille.Saluti,PDAIl problema che ho riscontrato è che, per come ho inserito le due istruzioni sopra riportate, la “X” appare dalla riga 1 in poi.inserisci la riga evidenziata nel tuo codice,If Agente.Value <> "" Then Elenco.Add Agente.Value 'aggiungilo ad Elenco 'rAgenti2.Value = "X" Cells(Agente.Row, "AD") = "X" Else: Agente = Agente + 1 End IfQual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente?( Alan Turing)
Ciao Albatros54,grazie mille.Almeno una cosa per ora è risolta.Purtroppo resta ancora il problema più grande:la "X" nella colonna AD deve essere inserita SOLO in corrispondenza di quei codici clienti per i quali è stato creato il relativo file.Credo che il problema sia nella funzione presente nel modulo 7 (bFound).Riusciresti a darmi qualche altro suggerimento?Grazie mille.Saluti,PDAnella routine del modulo6 "estraifile",inserisci queste righe di codice che non fanno altro che inserire una X solo quando viene creato il file,naturalmente devi poi adattare il Range("g6:g20"), se ho capito
Call InserisciTotali On Error Resume Next Application.DisplayAlerts = False NewWK.SaveAs Filename:=(Environ("USERPROFILE") & "\Desktop\" & "Archivio\" & myItem) Application.DisplayAlerts = True NewWK.Close Set rgtrovato = Range("g6:g20").Find(myItem) trovato = rgtrovato.Row Shc1.Cells(trovato, "AD") = "X" End If Next myItemQual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente?( Alan Turing)
Albatros54 sei un MITO!Grazie mille.Ho lavorato fino ad ora per adattarlo alle mie esigenze ed al file che uso tutti i giorni.A presto (ne ho di cose da sviluppare).PS Come faccio per RISOLVERE la discussione?Saluti,PDAIn fondo a questa pagina a sx combobox seleziona risolto click su aggiorna
CiaoQual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente?( Alan Turing)
Scusami, ma non trovo nessuna combobox.Com'è possibile?ti allego immagine, se trovi difficolta' lo posso inserire io
ciaoQual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente?( Alan Turing)
Ti allego l'immagine della schermata che mi appare.Continuo a non trovarla.Se puoi farlo tu, te ne sarei grato.Grazie mille.Saluti,PDAFatto! !
Grazie mille.Saluti,PDA
Login
Registrati
Stai vedendo 23 articoli - dal 1 a 23 (di 23 totali)
Stai vedendo 23 articoli - dal 1 a 23 (di 23 totali)