Ho installato kutools per assistere con un progetto di lavoro. Gestisco anche un report aziendale di grandi dimensioni che ha una macro che crea un'e-mail dalle informazioni inserite. Quella macro ha smesso di funzionare sul mio computer. Funziona sui computer che non hanno kutools. Qualcuno si è mai imbattuto in qualcosa del genere prima? Ecco la macro che funziona bene su altri computer:
Sub Mail_Sheet_Outlook_Body()
'Lavorare in Excel 2000-2016
Applicazione.ReferenceStyle = xlA1
Dim rng come intervallo
Dim OutApp come oggetto
Dim OutMail come oggetto
Dim xCartella come stringa
Dim xSht come foglio di lavoro
Dim xSub come stringa
Risposta debole come stringa
Dim Msg come stringa
Stile fioco come stringa
Titolo attenuato come stringa
Imposta xSht = Foglio attivo
Msg = "Sei sicuro di voler inviare questo modulo tramite e-mail?" ' Definisci messaggio.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Definisci pulsanti.
Titolo = "Conferma invio email" ' Definisci titolo.
Risposta = MsgBox(Msg, Stile)
Se Risposta = vbSì Allora
xFolder = Environ("USERPROFILE") + "\Desktop\" + "\Field Audit Form--" + CStr(xSht.Cells(19, "A").Value) + "--.pdf"
'xSub = "Field Audit for store " + CStr(xSht.Cells(19, "A").Value)
Con l'applicazione
.EnableEvents = False
.ScreenUpdating = False
Fine Con
Imposta rng = Niente
Imposta rng = ActiveSheet.UsedRange
'Puoi anche usare il nome di un foglio
'Set rng = Sheets("YourSheet").UsedRange
Imposta OutApp = CreateObject ("Outlook.Application")
Imposta OutMail = OutApp.CreateItem(0)
Dim varCellvalue As Long
On Error Resume Next
Con OutMail
.A = ""
.CC = ""
.BCC = ""
.Oggetto = "Riepilogo"
.Allegati.Aggiungi xCartella
.HTMLBody = RangetoHTML(rng)
.Display 'o usa .Display
Fine Con
On Error GoTo 0
Con l'applicazione
.EnableEvents = True
.ScreenUpdating = True
Fine Con
Imposta OutMail = Niente
Imposta OutApp = Niente
End If
End Sub
Funzione RangetoHTML(rng As Range)
' Lavorare in Office 2000-2016
Dim fso come oggetto
Oscura come oggetto
Dim TempFile come stringa
Dim TempWB come cartella di lavoro
TempFile = Environ$("temp") & "\" & Format(Ora, "gg-mm-aa h-mm-ss") & ".htm"
'Copia l'intervallo e crea una nuova cartella di lavoro in cui incollare i dati
rng.Copia
Imposta TempWB = Cartelle di lavoro.Aggiungi(1)
Con TempWB.Sheets(1)
.Cells(1).PasteSpecial Incolla:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Celle(1).Seleziona
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = Vero
.DrawingObjects.Elimina
On Error GoTo 0
Fine Con
'Pubblica il foglio in un file htm
Con TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Nome file:=FileTemp, _
Foglio:=TempWB.Sheets(1).Nome, _
Fonte:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatico)
.Pubblica (Vero)
Fine Con
'Leggi tutti i dati dal file htm in RangetoHTML
Imposta fso = CreateObject ("Scripting.FileSystemObject")
Imposta ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Chiudi
RangetoHTML = Sostituisci(RangetoHTML, "align=center x:publishsource=", _
"align=sinistra x:publishsource=")
'Chiudi TempWB
TempWB.Close savechanges:=Falso
'Cancella il file htm che abbiamo usato in questa funzione
Uccidi TempFile
Imposta ts = Niente
Imposta fso = Niente
Imposta TempWB = Niente
End Function
Sub Mail_Sheet_Outlook_Body()
'Lavorare in Excel 2000-2016
Applicazione.ReferenceStyle = xlA1
Dim rng come intervallo
Dim OutApp come oggetto
Dim OutMail come oggetto
Dim xCartella come stringa
Dim xSht come foglio di lavoro
Dim xSub come stringa
Risposta debole come stringa
Dim Msg come stringa
Stile fioco come stringa
Titolo attenuato come stringa
Imposta xSht = Foglio attivo
Msg = "Sei sicuro di voler inviare questo modulo tramite e-mail?" ' Definisci messaggio.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Definisci pulsanti.
Titolo = "Conferma invio email" ' Definisci titolo.
Risposta = MsgBox(Msg, Stile)
Se Risposta = vbSì Allora
xFolder = Environ("USERPROFILE") + "\Desktop\" + "\Field Audit Form--" + CStr(xSht.Cells(19, "A").Value) + "--.pdf"
'xSub = "Field Audit for store " + CStr(xSht.Cells(19, "A").Value)
Con l'applicazione
.EnableEvents = False
.ScreenUpdating = False
Fine Con
Imposta rng = Niente
Imposta rng = ActiveSheet.UsedRange
'Puoi anche usare il nome di un foglio
'Set rng = Sheets("YourSheet").UsedRange
Imposta OutApp = CreateObject ("Outlook.Application")
Imposta OutMail = OutApp.CreateItem(0)
Dim varCellvalue As Long
On Error Resume Next
Con OutMail
.A = ""
.CC = ""
.BCC = ""
.Oggetto = "Riepilogo"
.Allegati.Aggiungi xCartella
.HTMLBody = RangetoHTML(rng)
.Display 'o usa .Display
Fine Con
On Error GoTo 0
Con l'applicazione
.EnableEvents = True
.ScreenUpdating = True
Fine Con
Imposta OutMail = Niente
Imposta OutApp = Niente
End If
End Sub
Funzione RangetoHTML(rng As Range)
' Lavorare in Office 2000-2016
Dim fso come oggetto
Oscura come oggetto
Dim TempFile come stringa
Dim TempWB come cartella di lavoro
TempFile = Environ$("temp") & "\" & Format(Ora, "gg-mm-aa h-mm-ss") & ".htm"
'Copia l'intervallo e crea una nuova cartella di lavoro in cui incollare i dati
rng.Copia
Imposta TempWB = Cartelle di lavoro.Aggiungi(1)
Con TempWB.Sheets(1)
.Cells(1).PasteSpecial Incolla:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Celle(1).Seleziona
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = Vero
.DrawingObjects.Elimina
On Error GoTo 0
Fine Con
'Pubblica il foglio in un file htm
Con TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Nome file:=FileTemp, _
Foglio:=TempWB.Sheets(1).Nome, _
Fonte:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatico)
.Pubblica (Vero)
Fine Con
'Leggi tutti i dati dal file htm in RangetoHTML
Imposta fso = CreateObject ("Scripting.FileSystemObject")
Imposta ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Chiudi
RangetoHTML = Sostituisci(RangetoHTML, "align=center x:publishsource=", _
"align=sinistra x:publishsource=")
'Chiudi TempWB
TempWB.Close savechanges:=Falso
'Cancella il file htm che abbiamo usato in questa funzione
Uccidi TempFile
Imposta ts = Niente
Imposta fso = Niente
Imposta TempWB = Niente
End Function
Non ci sono ancora risposte per questo post.