By Gæst lørdag den 01. september 2018
Posted in Kutools til Excel
Svar 0
Synes godt om 0
Views 2.7K
Stemmer 0
Jeg installerede kutools for at hjælpe med et projekt for arbejde. Jeg administrerer også en stor virksomhedsrapport, der har en makro, der skaber en e-mail fra indtastede oplysninger. Den makro er holdt op med at virke på min computer. Det virker på de computere, der ikke har kutools. Er der nogen, der er stødt på sådan noget før? Her er makroen, der fungerer fint på andre computere:

Sub Mail_Sheet_Outlook_Body()
'Arbejder i Excel 2000-2016
Application.ReferenceStyle = xlA1
Dim rng As Range
Dim OutApp som objekt
Dæmp OutMail som objekt
Dim xFolder Som streng
Dim xSht som arbejdsark
Dim xSub som streng
Dim respons som streng
Dæmp besked som streng
Dim stil som streng
Dim titel som streng

Indstil xSht = ActiveSheet
Msg = "Er du sikker på, at du vil e-maile denne formular?" 'Definer besked.
Stil = vbYesNo + vbCritical + vbDefaultButton2 ' Definer knapper.
Title = "Bekræftelse af afsendelse af e-mail" ' Definer titel.
Svar = MsgBox(Msg, Style)

Hvis Svar = vbJa Så
xFolder = Environ("USERPROFILE") + "\Desktop\" + "\Field Audit Form--" + CStr(xSht.Cells(19, "A").Value) + "--.pdf"
'xSub = "Feltrevision for butik " + CStr(xSht.Cells(19, "A").Value)
Med Ansøgning
.EnableEvents = Falsk
.ScreenUpdating = Falsk
Slut med

Indstil rng = Intet
Indstil rng = ActiveSheet.UsedRange
'Du kan også bruge et arknavn
'Set rng = Sheets("YourSheet").UsedRange

Indstil OutApp = CreateObject("Outlook.Application")
Indstil OutMail = OutApp.CreateItem(0)
Dim varCellvalue As Long




On Error Resume Next
Med OutMail
.Til = ""
.CC = ""
.BCC = ""
.Subject = "Recap"
.Attachments.Add xFolder
.HTMLBody = RangetoHTML(rng)
.Display 'eller brug .Display

Slut med
På Fejl GoTo 0

Med Ansøgning
.EnableEvents = Sand
.ScreenUpdating = Sand
Slut med

Indstil OutMail = Intet
Indstil OutApp = Intet
End If
End Sub


Funktion RangetoHTML(rng As Range)
' Arbejder i Office 2000-2016
Dim fso som objekt
Dim ts som objekt
Dim TempFile As String
Dim TempWB som projektmappe

TempFile = Environ$("temp") & "\" & Format(Nu, "dd-mm-åå h-mm-ss") & ".htm"

'Kopiér området, og opret en ny projektmappe, hvor du kan indsætte dataene
rng.Kopi
Indstil TempWB = Workbooks.Add(1)
Med TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Celler(1).Vælg
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = Sand
.DrawingObjects.Delete
På Fejl GoTo 0
Slut med

'Udgiv arket til en htm-fil
Med TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filnavn:=TempFile, _
Ark:=TempWB.Sheets(1).Navn, _
Kilde:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Udgiv (True)
Slut med

'Læs alle data fra htm-filen ind i RangetoHTML
Sæt fso = CreateObject ("Scripting.FileSystemObject")
Indstil ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Luk
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")

'Luk TempWB
TempWB.Close savechanges:=False

'Slet den htm-fil, vi brugte i denne funktion
Dræb TempFile
Indstil ts = Intet
Indstil fso = Intet
Indstil TempWB = Intet

End Function
Se det fulde indlæg