The two calendar subs and the button click are events
The first run when you click on the calendar and the second run when you change the selection
The code in the button sub run when you click on the button
All three belong in the module of the sheet with the calendar and button
This have you done correct because your calendar is working
The macro
Sub Mail_ActiveSheet()
Must be in a normal module not in the sheet module
Alt F11
Insert module
See this page for more information
http://www.cpearson.com/excel/events.htm
--
Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm
"Josh Johansen" wrote in message ...
I am very sorry, I am unsure what you mean by event code and when you say
cut/paste the sub there. I am incredibly unfamiliar with VBA, I am sorry,
but thank you so much for your help.
"Ron de Bruin" wrote:
Hi Josh
The event code and the button code must be in the sheet module but the macro belong in a normal module
Alt F11
Insert module
Cut/paste the sub there
--
Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm
"Josh Johansen" wrote in message
...
I really appreciate all of your help, I have gone through your help lists and
downloaded your practice sheet and it worked great, but I am very confused
somewhere. Here is everything I have on the sheet code: The first and third
sections are for a calander, I am sorry it is so long, I really just dont
know what I am doing wrong.
Private Sub Calendar1_Click()
ActiveCell.Value = CDbl(Calendar1.Value)
ActiveCell.NumberFormat = "mm/dd/yyy"
ActiveCell.Select
Calendar1.Visible = False
End Sub
Private Sub CommandButton1_Click()
Call Mail_Range
End Sub
Private Sub Worksheet_Selectionchange(ByVal Target As Range)
If Target.Cells.Count 1 Then Exit Sub
If Not Application.Intersect(Range("F3"), Target) Is Nothing Then
Calendar1.Left = Range("E1").Left
Calendar1.Top = Range("E1").Top
Calendar1.Visible = True
' select Today's date in the Calendar
Calendar1.Value = Date
ElseIf Calendar1.Visible Then Calendar1.Visible = False
End If
End Sub
Sub Mail_ActiveSheet()
'Working in 2000-2007
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
'Copy the sheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
'We exit the sub when your answer is NO in the security dialog
that you only
'see when you copy a sheet from a xlsm file with macro's
disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With
' 'Change all cells in the worksheet to values if you want
' With Destwb.Sheets(1).UsedRange
' .Cells.Copy
' .Cells.PasteSpecial xlPasteValues
' .Cells(1).Select
' End With
' Application.CutCopyMode = False
'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy
h-mm-ss")
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add Destwb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
.Close SaveChanges:=False
End With
'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
"Ron de Bruin" wrote:
What is the code in the button click
Private Sub CommandButton1_Click()
End Sub
Must be
Private Sub CommandButton1_Click()
Call Mail_Range
End Sub
--
Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm
"Josh Johansen" wrote in message
...
Here is the code I put in... When I exit control mode and attempt to use the
button nothing happens. I am sure I copied something wrong, I am just not
familiar at all with VBA. Thanks again!
Sub Mail_Range()
'Working in 2000-2007
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:j200").SpecialCells(xlCellTypeVisible)
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.CutCopyMode = False
End With
TempFilePath = Environ$("temp") & "\"
TempFileName = "Selection of " & wb.Name & " " & Format(Now, "dd-mmm-yy
h-mm-ss")
If Val(Application.Version) < 12 Then
'You use Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add Dest.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
.Close SaveChanges:=False
End With
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
"Ron de Bruin" wrote:
Only possible when You use this
http://www.rondebruin.nl/mail/tips1.htm
.SendMail "", "This is the Subject line"
You have more control when you use the outlook code
http://www.rondebruin.nl/sendmail.htm
--
Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm
"Josh Johansen" wrote in message
...
first of all I have already gotten a lot of help from Tom Ogilvy, which I
really appreciate, but here is what he has helped me get so far:
Private Sub CommandButton1_Click()
Dim rng As Range
Set rng = ActiveSheet.PivotTables(1).TableRange2
Set rng = Range(rng(1).Offset(-7, 0), rng)
Workbooks.Add Template:=xlWBATWorksheet
ActiveSheet.Range("A1").Select
rng.Copy
ActiveSheet.Range("A1").PasteSpecial xlValues
ActiveSheet.Range("A1").PasteSpecial xlFormats
ActiveWorkbook.SendMail Subject:="Scheduling", "
ActiveWorkbook.Close SaveChanges:=False
End Sub