View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
[email protected] HammerJoe@gmail.com is offline
external usenet poster
 
Posts: 126
Default Send email in a different way

Here is what I come up with, need opinions on how to improve it:

Public Sub SendEmail()
Dim Msg As String
Dim Ws As Worksheet
Dim NewWs As Worksheet
ThisWorkbook.Sheets("Week_to_date").Unprotect ("XXX")
ThisWorkbook.Sheets("MonthlyTrack").Unprotect ("XXX")
If ThisWorkbook.Sheets("MonthlyTrack").Range("L20").V alue = True Then
'Hide all sheets
For Each Ws In Worksheets
If Ws.Name < "Week_to_date" Then
Ws.Visible = xlSheetHidden
End If
Next Ws
'///
Dim TmpWb As String
Dim btn As Button, Lbl As msforms.Label
Worksheets.Add
ThisWorkbook.ActiveSheet.Name = "Weekly Report"
ThisWorkbook.Sheets("Week_to_date").Select
Range("A1:C18").Select
Application.CutCopyMode = False
Selection.Copy

Sheets("Weekly Report").Activate
Sheets("Weekly Report").Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths,
Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Sheets("Week_to_date").Select
ActiveSheet.ChartObjects("Chart 1026").Activate
ActiveChart.ChartArea.Select
Application.CutCopyMode = False
ActiveChart.ChartArea.Copy
'ActiveWindow.Visible = False
Sheets("Weekly Report").Activate
Range("A3").Select
ActiveSheet.Paste
ActiveSheet.ChartObjects("Chart 1").Activate

Range("A3").Select
Set NewWs = ActiveSheet

With NewWs

NewWs.Range("B23") = "Select 'File'-'Send To'-'Mail Recipient' in
the Excel Menu."
NewWs.Range("B24") = "*Warning* Once this file is saved, all
previous week results will be lost!"
NewWs.Range("B26") = "Press the button below after you have sent
the email..."
Range("B21:B26").Select
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Set btn = NewWs.Buttons.Add(65.25, 462.75, 296.25, 32.25)
btn.Select
Selection.Characters.Text = "Yes, I understand!"
With Selection
.Font.Name = "Arial"
.Font.FontStyle = "Bold"
.Font.Size = 10
.Font.ColorIndex = xlAutomatic
.Locked = True
.LockedText = True
End With
btn.OnAction = "CommandButtonSendEmail"
End With

ThisWorkbook.Sheets("Week_to_date").Visible = xlSheetHidden

'Wait for user to send email
ThisWorkbook.Sheets("MonthlyTrack").Range("L21").V alue = False
NewWs.Activate
NewWs.Range("A1").Select
Do While ThisWorkbook.Sheets("MonthlyTrack").Range("L21").V alue =
False
DoEvents
Loop
ThisWorkbook.Sheets("Week_to_date").Visible = xlSheetVisible
Application.DisplayAlerts = False
NewWs.Delete
Application.DisplayAlerts = True
End If


'Show all sheets again
For Each Ws In Worksheets
Ws.Visible = xlSheetVisible
Next Ws
ThisWorkbook.Sheets("Week_to_date").Protect ("xxx")
Sheets("main").Activate
Sheets("main").Range("A1").Select
End Sub

Public Sub CommandButtonSendEmail()
ThisWorkbook.Sheets("MonthlyTrack").Range("L21").V alue = True
End Sub