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]
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
----------------------------------
Tidak ada komentar:
Posting Komentar