A
ab
Using Excel 2003 in Windows XP. I can't do anything with worksheets
(either by right-clicking or using Format or Insert in the toolbar).
I can't delete sheets, modify sheets, etc. Delete sheet, move sheet,
etc are all greyed out.
The workbook and worksheets are neither shared nor protected.
I am running macros, and the workbook is scheduled (w/ Scheduler) to
open at 5:30AM. It runs a macro at 5:45AM. The macro runs some
queries, calculates the sheets, saves a draft w/ attachment in my
Outlook inbox, and closes both the workbook and Excel. This morning,
the macro didn't complete due to 'too many cell formats' error. Below
is my code (I took out a bunch of the repetitive chunks that refresh
queries and calculate worksheets)
Sub refresh()
'
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim r As Integer
Dim cell As Range
Dim strto As String
' refresh Macro
' Refreshes CDLT111 (OT), CDLT112 (OT Adjustments), Daily Labor (All
hrs)
' cycles, crib reqs, scrap. Then calculates each sheet (OT weekly,
By Dept, By trade, etc)
'
'
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
{-- I took out all of the code which refreshes the queries in each
sheet --}
ActiveWorkbook.Save 'saves the main file
'selects and copies sheets for an archive/export file
Sheets(Array("Daily Stats", "OT Weekly", "By Trade", "By Dept",
"Requisitions By Dept", _
"Req Detail", "MTD IM", "Expense POs Detail", _
"New Committments by Dept", "New Committments Detail", "DL by
Dept", "Off Standard", _
"Absenteeism by Dept", "Scrap by Dept", "Scrap Detail", "IL by
Dept", "BWS by Dept", "Shipped Volumes", "emails")).Select
Sheets("OT Weekly").Activate
Sheets(Array("Daily Stats", "OT Weekly", "By Trade", "By Dept",
"Requisitions By Dept", _
"Req Detail", "MTD IM", "Expense POs Detail", _
"New Committments by Dept", "New Committments Detail", "DL by
Dept", "Off Standard", _
"Absenteeism by Dept", "Scrap by Dept", "Scrap Detail", "IL by
Dept", "BWS by Dept", "Shipped Volumes", "emails")).Copy
Windows("Book1").Activate 'breaks the links, otherwise the computer
runs out of resources
ActiveWorkbook.BreakLink Name:= _
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@" _
, Type:=xlExcelLinks
Set WB1 = ActiveWorkbook
ActiveWorkbook.ReadOnlyRecommended = True
'defines variables that will be used to save the file or that show up
in the email
savename = Worksheets("Emails").Range("b34").Text
Savetoday = Worksheets("Emails").Range("b35").Text
Subjectline = Worksheets("Emails").Range("b33").Text
emailbody = Worksheets("Emails").Range("b38").Text
emailbody2 = Worksheets("Emails").Range("b39").Text
to_list = Worksheets("Emails").Range("b36").Text
polrlink = Worksheets("Emails").Range("b43").Text
archivelink = Worksheets("Emails").Range("b30").Text
signature1 = Worksheets("Emails").Range("b46").Text
signature2 = Worksheets("Emails").Range("b47").Text
signature3 = Worksheets("Emails").Range("b48").Text
signature4 = Worksheets("Emails").Range("b49").Text
Sheets("Emails").Select
ActiveWorkbook.Sheets("emails").Visible = xlSheetVeryHidden
Sheets("OT Weekly").Select
Range("AC29").Select
'turns off warnings temporarily
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Saves an archive copy w/ today's date
With WB1
.SaveAs savename
End With
With WB1 'saves the archived copy as Today.xls, so the present day is
always available at
'a fixed location
.SaveAs Savetoday
End With
'pulls email addresses from Emails tab, column P
For Each cell In
Sheets("Emails").Columns("t").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" Then
strto = strto & cell.Value & ";"
strto = Left(strto, Len(strto))
End If
Next
'Creates an email
Set OutApp = CreateObject("Outlook.Application")
'turns off alerts and warnings - useful if replacing a file w/ an
updated file
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = strto 'puts email addresses from Emails tab into To:
box
.CC = "" 'blank
.BCC = "" 'blank
.Subject = Subjectline 'adds the name of the file as the
subject line
.Recipients.ResolveAll
'makes body of email HTML and puts in select statistics,
dependant on
'whether the day is Monday or another weekday. Also adds
POLR hyperlink and greeting
'based on data in emails
.HTMLBody = "Good Morning," & "<BR>" & "<BR>" & emailbody
& "<BR>" & "<BR>" & emailbody2 _
& "<BR>" & "<BR>" & "Today's File Link: <a href=""file://"
& Excel.ActiveWorkbook.FullNameURLEncoded & """>" & _
Excel.ActiveWorkbook.FullName & "</a>" & _
"</body></html>" & "<BR>" & "(Please open as Read-Only)" &
"<BR>" & "<BR>" _
& "Archived Files Link: <a href=""" & archivelink & """>" & _
archivelink & "</a>" & _
"</body></html>" & "<BR>" & "<BR>" _
& "POLR Web Link: <a href=""" & polrlink & """>" & _
polrlink & "</a>" & _
"</body></html>" & "<BR>" & "<BR>" & "<BR>" & signature1 &
"<BR>" & signature2 & "<BR>" & signature3 & "<BR>" & signature4
.Attachments.Add WB1.FullName 'adds the archived file as an
attachment
.Display 'displays the email
.Save 'saves the email as a draft
.Close olPromtForSave 'closes the email
End With
Set OutMail = Nothing
Set OutApp = Nothing
With WB1 'saves the archived copy as Today.xls, so the present day is
always available at
'a fixed location
.SaveAs Savetoday
End With
ActiveWorkbook.Close 'closes the workbook Today.xls
Application.DisplayAlerts = True 'turns alerts back on
Application.ScreenUpdating = True
Windows("Weekday Skilled Trades OT File.xls").Activate 'activates
window w/ main file (for saving)
Sheets("CDLT111").Select 'to ungroup the sheets
Sheets("OT Weekly").Select 'puts the point of view back on OT
Weekly
Range("s29").Select
ActiveWorkbook.Save 'saves the big file w/ all the data
Application.Quit 'gets out of excel
End Sub
(either by right-clicking or using Format or Insert in the toolbar).
I can't delete sheets, modify sheets, etc. Delete sheet, move sheet,
etc are all greyed out.
The workbook and worksheets are neither shared nor protected.
I am running macros, and the workbook is scheduled (w/ Scheduler) to
open at 5:30AM. It runs a macro at 5:45AM. The macro runs some
queries, calculates the sheets, saves a draft w/ attachment in my
Outlook inbox, and closes both the workbook and Excel. This morning,
the macro didn't complete due to 'too many cell formats' error. Below
is my code (I took out a bunch of the repetitive chunks that refresh
queries and calculate worksheets)
Sub refresh()
'
Dim WB1 As Workbook
Dim WB2 As Workbook
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim r As Integer
Dim cell As Range
Dim strto As String
' refresh Macro
' Refreshes CDLT111 (OT), CDLT112 (OT Adjustments), Daily Labor (All
hrs)
' cycles, crib reqs, scrap. Then calculates each sheet (OT weekly,
By Dept, By trade, etc)
'
'
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
{-- I took out all of the code which refreshes the queries in each
sheet --}
ActiveWorkbook.Save 'saves the main file
'selects and copies sheets for an archive/export file
Sheets(Array("Daily Stats", "OT Weekly", "By Trade", "By Dept",
"Requisitions By Dept", _
"Req Detail", "MTD IM", "Expense POs Detail", _
"New Committments by Dept", "New Committments Detail", "DL by
Dept", "Off Standard", _
"Absenteeism by Dept", "Scrap by Dept", "Scrap Detail", "IL by
Dept", "BWS by Dept", "Shipped Volumes", "emails")).Select
Sheets("OT Weekly").Activate
Sheets(Array("Daily Stats", "OT Weekly", "By Trade", "By Dept",
"Requisitions By Dept", _
"Req Detail", "MTD IM", "Expense POs Detail", _
"New Committments by Dept", "New Committments Detail", "DL by
Dept", "Off Standard", _
"Absenteeism by Dept", "Scrap by Dept", "Scrap Detail", "IL by
Dept", "BWS by Dept", "Shipped Volumes", "emails")).Copy
Windows("Book1").Activate 'breaks the links, otherwise the computer
runs out of resources
ActiveWorkbook.BreakLink Name:= _
"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@" _
, Type:=xlExcelLinks
Set WB1 = ActiveWorkbook
ActiveWorkbook.ReadOnlyRecommended = True
'defines variables that will be used to save the file or that show up
in the email
savename = Worksheets("Emails").Range("b34").Text
Savetoday = Worksheets("Emails").Range("b35").Text
Subjectline = Worksheets("Emails").Range("b33").Text
emailbody = Worksheets("Emails").Range("b38").Text
emailbody2 = Worksheets("Emails").Range("b39").Text
to_list = Worksheets("Emails").Range("b36").Text
polrlink = Worksheets("Emails").Range("b43").Text
archivelink = Worksheets("Emails").Range("b30").Text
signature1 = Worksheets("Emails").Range("b46").Text
signature2 = Worksheets("Emails").Range("b47").Text
signature3 = Worksheets("Emails").Range("b48").Text
signature4 = Worksheets("Emails").Range("b49").Text
Sheets("Emails").Select
ActiveWorkbook.Sheets("emails").Visible = xlSheetVeryHidden
Sheets("OT Weekly").Select
Range("AC29").Select
'turns off warnings temporarily
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Saves an archive copy w/ today's date
With WB1
.SaveAs savename
End With
With WB1 'saves the archived copy as Today.xls, so the present day is
always available at
'a fixed location
.SaveAs Savetoday
End With
'pulls email addresses from Emails tab, column P
For Each cell In
Sheets("Emails").Columns("t").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" Then
strto = strto & cell.Value & ";"
strto = Left(strto, Len(strto))
End If
Next
'Creates an email
Set OutApp = CreateObject("Outlook.Application")
'turns off alerts and warnings - useful if replacing a file w/ an
updated file
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = strto 'puts email addresses from Emails tab into To:
box
.CC = "" 'blank
.BCC = "" 'blank
.Subject = Subjectline 'adds the name of the file as the
subject line
.Recipients.ResolveAll
'makes body of email HTML and puts in select statistics,
dependant on
'whether the day is Monday or another weekday. Also adds
POLR hyperlink and greeting
'based on data in emails
.HTMLBody = "Good Morning," & "<BR>" & "<BR>" & emailbody
& "<BR>" & "<BR>" & emailbody2 _
& "<BR>" & "<BR>" & "Today's File Link: <a href=""file://"
& Excel.ActiveWorkbook.FullNameURLEncoded & """>" & _
Excel.ActiveWorkbook.FullName & "</a>" & _
"</body></html>" & "<BR>" & "(Please open as Read-Only)" &
"<BR>" & "<BR>" _
& "Archived Files Link: <a href=""" & archivelink & """>" & _
archivelink & "</a>" & _
"</body></html>" & "<BR>" & "<BR>" _
& "POLR Web Link: <a href=""" & polrlink & """>" & _
polrlink & "</a>" & _
"</body></html>" & "<BR>" & "<BR>" & "<BR>" & signature1 &
"<BR>" & signature2 & "<BR>" & signature3 & "<BR>" & signature4
.Attachments.Add WB1.FullName 'adds the archived file as an
attachment
.Display 'displays the email
.Save 'saves the email as a draft
.Close olPromtForSave 'closes the email
End With
Set OutMail = Nothing
Set OutApp = Nothing
With WB1 'saves the archived copy as Today.xls, so the present day is
always available at
'a fixed location
.SaveAs Savetoday
End With
ActiveWorkbook.Close 'closes the workbook Today.xls
Application.DisplayAlerts = True 'turns alerts back on
Application.ScreenUpdating = True
Windows("Weekday Skilled Trades OT File.xls").Activate 'activates
window w/ main file (for saving)
Sheets("CDLT111").Select 'to ungroup the sheets
Sheets("OT Weekly").Select 'puts the point of view back on OT
Weekly
Range("s29").Select
ActiveWorkbook.Save 'saves the big file w/ all the data
Application.Quit 'gets out of excel
End Sub