Rabu, 14 September 2011

[ExcelVBA] Re: Send Current Worksheet to Outlook

 

Sorry for the delayed response. The re-worked code worked perfectly once I figured out that the Ctrl+T shortcut was actually trying to create a table in Excel 2010.

Thanks,

Steve

--- In ExcelVBA@yahoogroups.com, "davidb" <dbraithwaite@...> wrote:
>
>
> Steve
>
>
>
> Looks like you are still having problems --- I reworked your code a
> bit...but this solution works for me...(xl2007)
>
> Let me know if it works for you.
>
>
>
> PURPOSE
>
> Copy visible rows of activesheet into new workbook and attach workbook
> to a mail message
>
>
>
>
>
> Here are the limitations
>
> ----------------------------------------------------------
>
> it will only NOT-COPY rows that are hidden as a result of excel Filter
> actions.
>
> It WILL copy any rows hidden by format>hide rows or by vba
> object.entirerow.hidden = true
>
> it WILL copy all columns, hidden or not
>
> It WILL NOT copy column formatting information since the filtered ranges
> that are copied are groups of rows.
>
>
>
> Sub EmailWithOutlook()
>
>
> 'Create new workbook with VISIBLE Cells from ActiveSheet
>
> 'NOTE:
> ' This WILL NOT COPY rows hidden by Excel FILTER, but
> ' will copy rows and columns hidden manually (format>hide)
> ' Manually hidden rows and columns will be unhidden in the
> ' target spreadsheet.
> '
> 'DECLARE VARIABLES
> '
> Dim strSheet_My As String, strSheet_New As String
> Dim strWorkbook_My As String
> Dim strWorkbook_New As String, strFilename_New As String,
> strWorkbook_New_Name As String
> '
> Dim oApp As Object, oMail As Object
> '
> 'INITIALIZE and SAVE CURRENT STATE
> '
> Application.ScreenUpdating = False
> strWorkbook_My = ActiveWorkbook.Name
> strSheet_My = ActiveSheet.Name
> '
> 'ADD NEW WORKBOOK
> '
> Workbooks.Add
> strWorkbook_New_Name = ActiveWorkbook.Name
> strWorkbook_New = strSheet_My & " (" & Format(Date, "mmddyy") & ")"
> strFilename_New = Environ("TEMP") & "\" & strWorkbook_New & ".xlsx"
> Sheets(1).Name = strWorkbook_New
> '
> Windows(strWorkbook_My).Activate
> Cells.Select
> Selection.Copy
> '
> 'PASTE TO NEW WORKBOOK
> '
> Windows(strWorkbook_New_Name).Activate
> Range("A1").Select
> With Selection
> .PasteSpecial _
> Paste:=xlPasteValues, _
> Operation:=xlNone, _
> SkipBlanks:=False, _
> Transpose:=False
> '
> .PasteSpecial _
> Paste:=xlPasteFormats, _
> Operation:=xlNone, _
> SkipBlanks:=False, _
> Transpose:=False
> End With
> Range("A1").Select
> '
> On Error Resume Next
> Kill strFilename_New 'make sure it does not exist
> '
> ActiveWorkbook.SaveAs _
> FileName:=strFilename_New, _
> FileFormat:=xlOpenXMLWorkbook, _
> CreateBackup:=False
> '
> ActiveWindow.Close
> '
> 'SEND FILE IN MAIL
> '
> Set oApp = CreateObject("Outlook.Application")
> Set oMail = oApp.CreateItem(0)
> With oMail
>
> 'Uncomment the line below to hard code a recipient
> '.To = "someone@"
> 'Uncomment the line below to hard code a subject
> '.Subject = "Look at my workbook!"
> '
> .Attachments.Add strFilename_New
> .Display
> End With
> '
> Set oMail = Nothing
> Set oApp = Nothing
> '
> 'DELETE TEMPORARY FILE AND CLEANUP
> '
> Kill strFilename_New
> Application.ScreenUpdating = True
> '
> Exit Sub
> End Sub
>
> db
>
>
>
> --- In ExcelVBA@yahoogroups.com, "sspatriots" <sspatriots@> wrote:
> >
> > David,
> >
> > Thanks. I did try several things with regards to how it was copying
> the informationj (selecting only visible cells), however, it was still
> getting hung up after that step. I'll go back and look at the pasting
> part more.
> >
> >
> > Regards,
> >
> > Steve
> >
> > --- In ExcelVBA@yahoogroups.com, "David Smart" smartware.consulting@
> wrote:
> > >
> > > It's always worth stepping through the actions you are trying to
> perform
> > > using manual commands when you can. What you're doing with the lines
> > >
> > > > ws.Cells.Copy
> > > > ws.[A1].PasteSpecial Paste:=xlValues
> > >
> > > is to overwrite the source cells with their values, as far as I can
> see.
> > >
> > > Now, if you have a filter on, then this is going to fail.
> Specifically,
> > > Excel will report that the selection is not valid for one of several
> > > reasons. The applicable one would be "Copy and paste areas cannot
> overlap
> > > unless they're the same size and shape".
> > >
> > > Your copy selection is the filtered area (i.e. there are rows that
> aren't
> > > included in the copy). Your paste area, A1 and auto extended down,
> is
> > > probably all consecutive rows, including those that are filtered
> out. Or
> > > perhaps it's the area from A1 down to where the first filtered row
> is. It's
> > > difficult to see. But it's the wrong size anyway.
> > >
> > > If you really need to handle filtered worksheet, then you probably
> have a
> > > bit of fiddling to do, assuming you want to retain manual row
> heights. I
> > > suspect you need to get your code to do the following:
> > >
> > > - Make a copy of the whole sheet, so as to include column widths and
> manual
> > > row heights.
> > > - Select the used cells in the copy and delete their rows. (Not that
> you
> > > would only need to do this if you had manual row heights.) If all
> rows are
> > > auto fit, then you can simply delete the cell contents instead.
> > > - Select the used cells in the original and copy them to the copy
> (note
> > > "paste" not "paste special"). This should get just the visible rows
> across,
> > > complete with their formatting and manual row heights.
> > > - Select the used cells in the copy (not filtered here), and do your
> paste
> > > special, etc, and then put the copy into the e-mail.
> > > - Discard the copy worksheet.
> > >
> > > You'll need to do a bit of trial and error to get the right
> procedure
> > > working here. You can experiment with manual actions, and then
> simply
> > > record it to a macro and copy the code out.
> > >
> > > There is an added benefit with this, of leaving your source sheet
> with its
> > > formulas, etc, intact, so it is less destructive than pasting in
> place.
> > >
> > > Regards, Dave S
> > >
> > > ----- Original Message -----
> > > From: "sspatriots" sspatriots@
> > > To: ExcelVBA@yahoogroups.com
> > > Sent: Friday, September 02, 2011 11:42 PM
> > > Subject: [ExcelVBA] Send Current Worksheet to Outlook
> > >
> > >
> > > > Hi,
> > > >
> > > > I have the code below that I use with a 'Ctrl+t' shortcut to
> automatically
> > > > place a copy of my current worksheet (values only) into a new
> e-mail as an
> > > > attachment. I went to use it this morning and it doesn't seem to
> like the
> > > > following line when I try and use it having a filtered column.
> > > >
> > > > ws.[A1].PasteSpecial Paste:=xlValues
> > > >
> > > > I tried adding a few lines telling it to select only visible
> cells, but
> > > > that ended up not being the issue, because when I use Debug, it
> keeps
> > > > pointing me back to the line of code above.
> > > >
> > > > Any help fixing this to work with filtered columns would be
> greatly
> > > > appreciated.
> > > >
> > > > Thanks,
> > > >
> > > > Steve
> > > >
> > > >
> > > >
> > > > Sub EmailWithOutlook()
> > > > 'Variable declaration
> > > > Dim strMyName As String
> > > > Dim ws As Worksheet
> > > > Dim oApp As Object, _
> > > > oMail As Object, _
> > > > WB As Workbook, _
> > > > FileName As String
> > > > strMyName = ActiveSheet.Name
> > > >
> > > > 'Turn off screen updating
> > > > Application.ScreenUpdating = False
> > > >
> > > > 'Make a copy of the active sheet and save it to
> > > > 'a temporary file
> > > > ActiveSheet.Copy
> > > >
> > > > For Each ws In ActiveWorkbook.Worksheets
> > > > ws.Cells.Copy
> > > >
> > > > ws.[A1].PasteSpecial Paste:=xlValues
> > > > ws.Cells.Hyperlinks.Delete
> > > > Application.CutCopyMode = False
> > > > Cells(1, 1).Select
> > > > ws.Activate
> > > > ws.Name = strMyName & " (" & Format(Date, "mmddyy") & ")"
> > > > Next ws
> > > >
> > > >
> > > >
> > > > Set WB = ActiveWorkbook
> > > > FileName = strMyName & ".xlsx"
> > > > On Error Resume Next
> > > > Kill "C:\" & FileName
> > > > On Error GoTo 0
> > > > WB.SaveAs FileName:="C:\" & FileName
> > > >
> > > > 'Create and show the outlook mail item
> > > > Set oApp = CreateObject("Outlook.Application")
> > > > Set oMail = oApp.CreateItem(0)
> > > > With oMail
> > > > 'Uncomment the line below to hard code a recipient
> > > > '.To = "someone@"
> > > > 'Uncomment the line below to hard code a subject
> > > > '.Subject = "Look at my workbook!"
> > > > .Attachments.Add WB.FullName
> > > > .Display
> > > > End With
> > > >
> > > > 'Delete the temporary file
> > > > WB.ChangeFileAccess Mode:=xlReadOnly
> > > > Kill WB.FullName
> > > > WB.Close SaveChanges:=False
> > > >
> > > > 'Restore screen updating and release Outlook
> > > > Application.ScreenUpdating = True
> > > > Set oMail = Nothing
> > > > Set oApp = Nothing
> > > > End Sub
> > > >
> > > >
> > > >
> > > > ------------------------------------
> > > >
> > > > ----------------------------------
> > > > Be sure to check out TechTrax Ezine for many, free Excel VBA
> articles! Go
> > > > here: http://www.mousetrax.com/techtrax to enter the ezine, then
> search
> > > > the ARCHIVES for EXCEL VBA.
> > > >
> > > > ----------------------------------
> > > > Visit our ExcelVBA group home page for more info and support
> files:
> > > > http://groups.yahoo.com/group/ExcelVBA
> > > >
> > > > ----------------------------------
> > > > More free tutorials and resources available at:
> > > > http://www.mousetrax.com
> > > >
> > > > ----------------------------------Yahoo! Groups Links
> > > >
> > > >
> > > >
> > > >
> > > >
> > > > -----
> > > > No virus found in this message.
> > > > Checked by AVG - www.avg.com
> > > > Version: 10.0.1392 / Virus Database: 1520/3871 - Release Date:
> 09/01/11
> > > >
> > >
> >
>
>
>
>
> [Non-text portions of this message have been removed]
>

__._,_.___
Recent Activity:
----------------------------------
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.

----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA

----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com

----------------------------------
MARKETPLACE

Stay on top of your group activity without leaving the page you're on - Get the Yahoo! Toolbar now.


A bad score is 598. A bad idea is not checking yours, at freecreditscore.com.
.

__,_._,___

Tidak ada komentar:

Posting Komentar