| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Runtime Error '-2147417848 (80010108)'
Can anyone help me ... I keep getting the following message
Runtime Error '-2147417848 (80010108)' Automation Error The object invoked has disconnected from its clients The macro in question is listed below and is used to create and name multiple worksheets by copying a template worksheet called 'TowerMaster' based on a variable input list. This used to work perfectly until yesterday... now it crashes after looping through the first time and creates a copy of 'TowerMaster' called 'TowerMaster (2)' and then stops ? The VBA code is listd below : Option Explicit Sub InitialTowerCreation() Dim TowerName As Range Dim NewTowerName As String Dim iResponse As Integer iResponse = MsgBox("This Macro should only be used once to create Tower Worksheets from initial Tower List. Do you wish to Continue ?", vbYesNo) 'display statement to execute if ok If iResponse = vbNo Then MsgBox "You selected No" Exit Sub End If If iResponse = vbYes Then MsgBox "You selected Yes" End If Sheets("TowerMaster").Visible = True For Each TowerName In PickLists.[List_Towers] If TowerName < "???" Then NewTowerName = TowerName Sheets("TowerMaster").Select Application.CutCopyMode = False Sheets("TowerMaster").Copy befo=Sheets("TowerMaster") Sheets("TowerMaster (2)").Select Sheets("TowerMaster (2)").Name = TowerName Range("A6:A7").Select ActiveCell.FormulaR1C1 = TowerName ActiveWorkbook.Names.Add Name:="Data1_" & TowerName, RefersToR1C1:= _ "=R11C1:R15C59" ActiveWorkbook.Names.Add Name:="Data2_" & TowerName, RefersToR1C1:= _ "=R27C1:R31C59" ActiveWorkbook.Names.Add Name:="Data3_" & TowerName, RefersToR1C1:= _ "=R43C1:R47C59" 'create Job Level Validation Range on sheet Job Levels Sheets("Job Levels").Select Rows("98:105").Select Range("B98").Activate Selection.Insert Shift:=xlDown Range("Lev_MasterRng").Select Selection.Copy Rows("98:98").Select ActiveSheet.Paste Range("C98:C105").Select Application.CutCopyMode = False ActiveWorkbook.Names.Add Name:="Lev_" & TowerName, RefersToR1C1:= _ "='Job Levels'!R98C3:R105C3" Range("a98").Select ActiveCell.FormulaR1C1 = TowerName 'create Job Level validation on Towersheet Sheets("TowerMaster").Select Calculate Calculate Sheets(NewTowerName).Select Range("F11:F14,F16").Select Range("F16").Activate With Selection.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:="=Lev_" & TowerName .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With Else 'do nothing End If On Error Resume Next Next TowerName Sheets("TowerMaster").Select ActiveWindow.SelectedSheets.Visible = False Calculate Sheets("PickLists").Select RefreshRates End Sub This used to work perfectly until yesterday... now it crashes after creating the first new worksheet from the list ?? -- Regards & Thanks |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Runtime Error '-2147417848 (80010108)'
Ian
I assume that there system is still the same. It may be that the workbook code has got corrupted. You could try exporting alll the code to a text file. Deleteing all the modules and worksheet code if you have it and forms and then importing them back in. This may solve your problem If you look here http://www.appspro.com/Utilities/CodeCleaner.htm Rob Bovey has an excellent add-in that automates this entire process down to a two mouse clicks. -- Hope this helps Martin Fishlock, Bangkok, Thailand Please do not forget to rate this reply. "Ian" wrote: Can anyone help me ... I keep getting the following message Runtime Error '-2147417848 (80010108)' Automation Error The object invoked has disconnected from its clients The macro in question is listed below and is used to create and name multiple worksheets by copying a template worksheet called 'TowerMaster' based on a variable input list. This used to work perfectly until yesterday... now it crashes after looping through the first time and creates a copy of 'TowerMaster' called 'TowerMaster (2)' and then stops ? The VBA code is listd below : Option Explicit Sub InitialTowerCreation() Dim TowerName As Range Dim NewTowerName As String Dim iResponse As Integer iResponse = MsgBox("This Macro should only be used once to create Tower Worksheets from initial Tower List. Do you wish to Continue ?", vbYesNo) 'display statement to execute if ok If iResponse = vbNo Then MsgBox "You selected No" Exit Sub End If If iResponse = vbYes Then MsgBox "You selected Yes" End If Sheets("TowerMaster").Visible = True For Each TowerName In PickLists.[List_Towers] If TowerName < "???" Then NewTowerName = TowerName Sheets("TowerMaster").Select Application.CutCopyMode = False Sheets("TowerMaster").Copy befo=Sheets("TowerMaster") Sheets("TowerMaster (2)").Select Sheets("TowerMaster (2)").Name = TowerName Range("A6:A7").Select ActiveCell.FormulaR1C1 = TowerName ActiveWorkbook.Names.Add Name:="Data1_" & TowerName, RefersToR1C1:= _ "=R11C1:R15C59" ActiveWorkbook.Names.Add Name:="Data2_" & TowerName, RefersToR1C1:= _ "=R27C1:R31C59" ActiveWorkbook.Names.Add Name:="Data3_" & TowerName, RefersToR1C1:= _ "=R43C1:R47C59" 'create Job Level Validation Range on sheet Job Levels Sheets("Job Levels").Select Rows("98:105").Select Range("B98").Activate Selection.Insert Shift:=xlDown Range("Lev_MasterRng").Select Selection.Copy Rows("98:98").Select ActiveSheet.Paste Range("C98:C105").Select Application.CutCopyMode = False ActiveWorkbook.Names.Add Name:="Lev_" & TowerName, RefersToR1C1:= _ "='Job Levels'!R98C3:R105C3" Range("a98").Select ActiveCell.FormulaR1C1 = TowerName 'create Job Level validation on Towersheet Sheets("TowerMaster").Select Calculate Calculate Sheets(NewTowerName).Select Range("F11:F14,F16").Select Range("F16").Activate With Selection.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:="=Lev_" & TowerName .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With Else 'do nothing End If On Error Resume Next Next TowerName Sheets("TowerMaster").Select ActiveWindow.SelectedSheets.Visible = False Calculate Sheets("PickLists").Select RefreshRates End Sub This used to work perfectly until yesterday... now it crashes after creating the first new worksheet from the list ?? -- Regards & Thanks |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Runtime Error '-2147417848 (80010108)'
Martin,
thanks for suggestion, but still have the problem -- Regards & Thanks "Martin Fishlock" wrote: Ian I assume that there system is still the same. It may be that the workbook code has got corrupted. You could try exporting alll the code to a text file. Deleteing all the modules and worksheet code if you have it and forms and then importing them back in. This may solve your problem If you look here http://www.appspro.com/Utilities/CodeCleaner.htm Rob Bovey has an excellent add-in that automates this entire process down to a two mouse clicks. -- Hope this helps Martin Fishlock, Bangkok, Thailand Please do not forget to rate this reply. "Ian" wrote: Can anyone help me ... I keep getting the following message Runtime Error '-2147417848 (80010108)' Automation Error The object invoked has disconnected from its clients The macro in question is listed below and is used to create and name multiple worksheets by copying a template worksheet called 'TowerMaster' based on a variable input list. This used to work perfectly until yesterday... now it crashes after looping through the first time and creates a copy of 'TowerMaster' called 'TowerMaster (2)' and then stops ? The VBA code is listd below : Option Explicit Sub InitialTowerCreation() Dim TowerName As Range Dim NewTowerName As String Dim iResponse As Integer iResponse = MsgBox("This Macro should only be used once to create Tower Worksheets from initial Tower List. Do you wish to Continue ?", vbYesNo) 'display statement to execute if ok If iResponse = vbNo Then MsgBox "You selected No" Exit Sub End If If iResponse = vbYes Then MsgBox "You selected Yes" End If Sheets("TowerMaster").Visible = True For Each TowerName In PickLists.[List_Towers] If TowerName < "???" Then NewTowerName = TowerName Sheets("TowerMaster").Select Application.CutCopyMode = False Sheets("TowerMaster").Copy befo=Sheets("TowerMaster") Sheets("TowerMaster (2)").Select Sheets("TowerMaster (2)").Name = TowerName Range("A6:A7").Select ActiveCell.FormulaR1C1 = TowerName ActiveWorkbook.Names.Add Name:="Data1_" & TowerName, RefersToR1C1:= _ "=R11C1:R15C59" ActiveWorkbook.Names.Add Name:="Data2_" & TowerName, RefersToR1C1:= _ "=R27C1:R31C59" ActiveWorkbook.Names.Add Name:="Data3_" & TowerName, RefersToR1C1:= _ "=R43C1:R47C59" 'create Job Level Validation Range on sheet Job Levels Sheets("Job Levels").Select Rows("98:105").Select Range("B98").Activate Selection.Insert Shift:=xlDown Range("Lev_MasterRng").Select Selection.Copy Rows("98:98").Select ActiveSheet.Paste Range("C98:C105").Select Application.CutCopyMode = False ActiveWorkbook.Names.Add Name:="Lev_" & TowerName, RefersToR1C1:= _ "='Job Levels'!R98C3:R105C3" Range("a98").Select ActiveCell.FormulaR1C1 = TowerName 'create Job Level validation on Towersheet Sheets("TowerMaster").Select Calculate Calculate Sheets(NewTowerName).Select Range("F11:F14,F16").Select Range("F16").Activate With Selection.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:="=Lev_" & TowerName .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With Else 'do nothing End If On Error Resume Next Next TowerName Sheets("TowerMaster").Select ActiveWindow.SelectedSheets.Visible = False Calculate Sheets("PickLists").Select RefreshRates End Sub This used to work perfectly until yesterday... now it crashes after creating the first new worksheet from the list ?? -- Regards & Thanks |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Runtime Error '-2147417848 (80010108)'
If you want to send me the workbook I can try looking at it on my system.
martin@fishlock @ yahoo.co.uk.cutthis remove the spaces and .cutthis. -- Hope this helps Martin Fishlock, Bangkok, Thailand Please do not forget to rate this reply. "Ian" wrote: Martin, thanks for suggestion, but still have the problem -- Regards & Thanks "Martin Fishlock" wrote: Ian I assume that there system is still the same. It may be that the workbook code has got corrupted. You could try exporting alll the code to a text file. Deleteing all the modules and worksheet code if you have it and forms and then importing them back in. This may solve your problem If you look here http://www.appspro.com/Utilities/CodeCleaner.htm Rob Bovey has an excellent add-in that automates this entire process down to a two mouse clicks. -- Hope this helps Martin Fishlock, Bangkok, Thailand Please do not forget to rate this reply. "Ian" wrote: Can anyone help me ... I keep getting the following message Runtime Error '-2147417848 (80010108)' Automation Error The object invoked has disconnected from its clients The macro in question is listed below and is used to create and name multiple worksheets by copying a template worksheet called 'TowerMaster' based on a variable input list. This used to work perfectly until yesterday... now it crashes after looping through the first time and creates a copy of 'TowerMaster' called 'TowerMaster (2)' and then stops ? The VBA code is listd below : Option Explicit Sub InitialTowerCreation() Dim TowerName As Range Dim NewTowerName As String Dim iResponse As Integer iResponse = MsgBox("This Macro should only be used once to create Tower Worksheets from initial Tower List. Do you wish to Continue ?", vbYesNo) 'display statement to execute if ok If iResponse = vbNo Then MsgBox "You selected No" Exit Sub End If If iResponse = vbYes Then MsgBox "You selected Yes" End If Sheets("TowerMaster").Visible = True For Each TowerName In PickLists.[List_Towers] If TowerName < "???" Then NewTowerName = TowerName Sheets("TowerMaster").Select Application.CutCopyMode = False Sheets("TowerMaster").Copy befo=Sheets("TowerMaster") Sheets("TowerMaster (2)").Select Sheets("TowerMaster (2)").Name = TowerName Range("A6:A7").Select ActiveCell.FormulaR1C1 = TowerName ActiveWorkbook.Names.Add Name:="Data1_" & TowerName, RefersToR1C1:= _ "=R11C1:R15C59" ActiveWorkbook.Names.Add Name:="Data2_" & TowerName, RefersToR1C1:= _ "=R27C1:R31C59" ActiveWorkbook.Names.Add Name:="Data3_" & TowerName, RefersToR1C1:= _ "=R43C1:R47C59" 'create Job Level Validation Range on sheet Job Levels Sheets("Job Levels").Select Rows("98:105").Select Range("B98").Activate Selection.Insert Shift:=xlDown Range("Lev_MasterRng").Select Selection.Copy Rows("98:98").Select ActiveSheet.Paste Range("C98:C105").Select Application.CutCopyMode = False ActiveWorkbook.Names.Add Name:="Lev_" & TowerName, RefersToR1C1:= _ "='Job Levels'!R98C3:R105C3" Range("a98").Select ActiveCell.FormulaR1C1 = TowerName 'create Job Level validation on Towersheet Sheets("TowerMaster").Select Calculate Calculate Sheets(NewTowerName).Select Range("F11:F14,F16").Select Range("F16").Activate With Selection.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:="=Lev_" & TowerName .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With Else 'do nothing End If On Error Resume Next Next TowerName Sheets("TowerMaster").Select ActiveWindow.SelectedSheets.Visible = False Calculate Sheets("PickLists").Select RefreshRates End Sub This used to work perfectly until yesterday... now it crashes after creating the first new worksheet from the list ?? -- Regards & Thanks |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Runtime Error -2147417848 (80010108) | Excel Programming | |||
| Active x Calendar control error (-2147417848 (80010108)) | Excel Programming | |||
| Excel Bug: Run-time error '-2147417848 (80010108)' | Excel Programming | |||
| Automation error -2147417848 (80010108) | Excel Programming | |||
| Run time error 2147417848(80010108) | Excel Programming | |||
Linear Mode
