Godaften Hol
Jeg har i længere tid rodet med Microsoft Excel VBA, men er kommet lidt til kort med min seneste opgave.
Kort fortalt skal jeg i en stor excel workbook kopiere et afgrænset område ind i en ny workbook, som skal sendes til en liste af kontaktpersoner via Microsoft Outlook. Jeg har skrevet alt koden til at udfører opgaven, men den giver mig et bug med hensyn til flettede celler.
Koden er som følger:
Sub Mail_Range()
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object
Set Source = Nothing
On Error Resume Next
Set Source = Range("A1:K50").SpecialCells(xlCellTypeVisib-
le)
On Error GoTo 0
If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected. " & _
"Please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.C-
utCopyMode = False
End With
TempFilePath = Environ$("temp") & "\"
TempFileName = "Selection of " & wb.Name & " " _
& Format(Now, "dd-mmm-yy h-mm-ss")
If Val(Application.Version)
--
Veni Vini Vici