Ciao a tutti! ho bisogno del vostro aiuto perchè sinceramente la mia scarsa conoscenza di programmazione non mi aiuta a risolvere.
Spiego utilizzavo una macro perfetta per la mia esigenza, praticamente avevo la necessità di stampare determinati fogli contenenti fatture, numerati da 1 a 400 con dei buchi di numeri(il numero è il codice cliente), in base alla presenza o meno di un si:
immaginatelo cosi': do la macro, mi chiede quale periodo, e stampa tutti i fogli dove sotto la colonna scelta, del foglio "stampa", trova SI:
Cod. 1trim 2trim 3trim 4trim post
1 SI SI SI SI NO
2 SI NO SI NO NO
3 SI SI SI SI NO
4 SI NO NO NO NO
...
400 NO NO NO NO SI
Adesso però con l'invio delle fatture via email, la mia necessità in parte è stata modifica, avevo bisogno di salvare la fattura in pdf nella propria cartella cliente nominata con lo stesso numero del cliente e spedirla automaticamente in thunderbird con delle determinate specifiche impostate, quindi
QUI, LINK, ho chiesto come poterla modificare e la macro che mi è stata gentilmente data è questa:
'=========>>
Option Explicit
'--------->>
Public Sub StampaFatture()
Dim ws As Worksheet
Dim r As Long, lColumn As Long
Dim vPrintColumn As Variant
Dim vData As Variant
Dim sPath As String, sStr As String, sFullname As String
Const sPercorso As String = "E:\Cartella Documenti per clienti\"
On Error GoTo Uffa
vPrintColumn = Application.InputBox( _
"inserire valore relativo al trimestre da stampare (2-6) 2= 1° TRIM 3= 2° TRIM 4= 3° TRIM 5= 4° TRIM 6= TRIM POST ", "Stampa fatture")
If (vPrintColumn < 2) Or (vPrintColumn > 6) Then Exit Sub
Application.ScreenUpdating = False
'-- modifica il nome del foglio contenente le informazioni di stampa
With ThisWorkbook.Worksheets("Stampa")
vData = .Cells(1, 1).CurrentRegion.Value
End With
lColumn = vPrintColumn
For r = 2 To UBound(vData)
'--- condizione di stampa: codice cliente e SI/si nella colonna
If Len(vData(r, 1)) And _
LCase(Trim(vData(r, lColumn))) = "si" Then
With Worksheets(CStr(vData(r, 1)))
sStr = .Cells(12, 2).Value & "\fatture\" _
& "Fattura" & "_" _
& "n°" & "_" _
& .Cells(12, 2).Value _
& "_" & .Cells(13, 6).Value _
& ".pdf"
sFullname = sPercorso & sStr
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=sFullname, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
'Call SendMailTest(sFullname)
End If
Next
Application.ScreenUpdating = True
ExitHere:
On Error Resume Next
Exit Sub
Uffa:
Call MsgBox("Ohibò, si è verificato il seguente errore: " _
& vbNewLine & _
CStr(Err.Number) & ": " _
& Err.Description _
& vbNewLine & vbNewLine & _
"Cliente in elaborazione: " & vData(r, 1), _
vbCritical + vbOKOnly, "Error message")
Resume ExitHere
End Sub
'--------->>
.Cells(12, 2).Value questo valore è il numero cliente nonchè nome del foglio
.Cells(12, 2).Value questo valore è il numero della fattura
.Cells(13, 6).Value questo valore è l'indirizzo
E fin qui ci siamo, la nuova macro, salva in pdf in ogni cartella specifica del cliente.
Adesso però purtroppo non trovo risposta per lo step seguente, che sarebbe quello di prendere il file dalla sua cartella cliente, allegarlo ad un'email, così per ogni file creato, con queste specifiche:
'--------->>
Public Sub SendMailTest(ByVal sAllegato As String)
Dim BodyMsg As String
Dim Indirizzo As String, Oggetto As String, PercorsoPdf As String
Dim Via As String, Fattura As String, Condominio As String
Dim Data As String, Amm As String
BodyMsg = "Spett.le Amministrazione" & Amm & "," _
& vbCrLf _
& "ai sensi della Circolare Agenzia delle Entrate 45/E del 19/10/2005, " _
& "Vi trasmettiamo in allegato la fattura di manutenzione ordinaria n°" _
& Fattura & " del" & Data _
& vbCrLf & "dell'impianto ascensore del" & Condominio _
& "di" & Via & "in formato PDF che vorrete stampare e conservare " _
& "secondo le modalità di legge." _
& vbCrLf & vbCrLf & "Con l'occasione, porgiamo i nostri migliori saluti. " _
& vbCrLf & "" _
& vbCrLf & "Si prega gentilmente di dare conferma avvenuta lettura."
Data = Range("B14").Value
Amm = Range("Q3").Value
Condominio = Range("K3").Value
Fattura = Range("B12").Value
Via = Range("K4").Value
Indirizzo = Range("R9").Value
Oggetto = "Invio Fattura"
Shell "C:\Programmi\Mozilla Thunderbird\thunderbird -compose " _
& Chr$(34) & "to='" & Indirizzo & "',subject='" _
& Oggetto & "',body='" _
& BodyMsg _
& "',attachment='" _
& PercorsoPdf & "'" _
& Chr$(34), vbNormalFocus
Application.Wait Now + TimeValue("00:00:03")
SendKeys "^{ENTER}"
End Sub
'<<=========
Questa macro però in parte non funziona, l'email non mi popola i dati prelevati nel body, ho chiesto come fare
QUI, LINK, per farla funzionare indipendemente dalla macro precedente, ma anche qui non ho trovato risposta.
In questo momento quando devo mandare una fattura per email utilizzo questo processo:
una volta salvato il pdf con un altra macro poi faccio il call con questa:
Sub Scegli_File_pdfxfatture()
Dim sAllegato As String
ChDir "F:\Fatture\" 'DIRECTORY DOVE SI APRIRà LA FINESTRA DI DIALOGO
sAllegato = Application.GetOpenFilename("File pdf, *.pdf", , "Scegli il file pdf da allegare")
If sAllegato = "Falso" Then
MsgBox "Operazione annullata", vbExclamation
Else
Call sendmailTH_by_Zero1(sAllegato)
End If
End Sub
Sub sendmailTH_by_Zero1(ByVal sAllegato As String)
Dim BodyMsg As String, Indirizzo As String, Oggetto As String, PercorsoPdf As String
BodyMsg = "Spett.le Amministrazione," _
& vbCrLf & "ai sensi della Circolare Agenzia delle Entrate 45/E del 19/10/2005, Vi trasmettiamo in allegato la fattura di manutenzione ordinaria n° del" _
& vbCrLf & "dell'impianto ascensore del condominio di Via in formato PDF che vorrete stampare e conservare secondo le modalità di legge." _
& vbCrLf & vbCrLf & "Con l'occasione, porgiamo i nostri migliori saluti. " _
& vbCrLf & "" _
& vbCrLf & "Si prega gentilmente di dare conferma avvenuta lettura."
Indirizzo = Range("R9").Value
Oggetto = "Invio Fattura"
PercorsoPdf = sAllegato
Shell "C:\Programmi\Mozilla Thunderbird\thunderbird -compose " _
& Chr$(34) & "to='" & Indirizzo & "',subject='" & Oggetto & "',body='" & BodyMsg _
& "',attachment='" & PercorsoPdf & "'" & Chr$(34), vbNormalFocus
Application.Wait Now + TimeValue("00:00:03")
SendKeys "^{ENTER}"
End Sub
Però con questa i dati nel body ogni volta li devo inserire manualmente, quindi volevo automatizzarla ulteriormente per snellire e velocizzare il processo come richiesto in "SendMailTest".
Spero di essermi spiegato.
Metto le mani avanti , perchè so cos'è il crossposting e non voglio creare problemi, quindi se dovesse infrangere qualche regolamento, chiedo scusa in anticipo e cancellate di conseguenza; se verrà risolto il mio problema, metterò le soluzioni anche in questi forum, come in passato ho già fatto senza problemi ;)
Quindi se c'è qualcuno che può risolvere il mio problema gliene sarò immensamente grato, altrimenti amen e grazie lo stesso :)
[Modificato da Paulkind78 13/10/2017 22:32]