W
Winshent
Can anyone tell why this code should run on excel 2000 (Win2k)machine
and not excel 2002 (WinXP)?
It creates a workbook, copies certain sheets accross, and then deletes
the code from the new workbook. And its giving me major hasle and the
client site. I have no means of testing with the same environment
here.
###################################################################
Option Explicit
Public strFileName As String
Public strPath As String
'
Public Sub DeleteAllCode()
On Error Resume Next
With ActiveWorkbook.VBProject
For x = .VBComponents.Count To 1 Step -1
.VBComponents.Remove .VBComponents(x)
Next x
For x = .VBComponents.Count To 1 Step -1
.VBComponents(x).CodeModule.DeleteLines _
1, .VBComponents(x).CodeModule.CountOfLines
Next x
End With
On Error GoTo 0
End Sub
Public Sub CreateEndUserBook(ByVal DorW As String)
Dim strWkBookName As String
strPath = ActiveWorkbook.Path
strPath = strPath & "\"
strWkBookName = ActiveWorkbook.Name
Dim WkSheet As Worksheet
Dim AllSheets As Sheets
Set AllSheets = Worksheets
'Stop
For Each WkSheet In AllSheets
Debug.Print WkSheet.Name
Sheets(WkSheet.Name).Activate
ActiveSheet.Unprotect Password:="Dub"
Next WkSheet
If DorW = "D" Then
strFileName = "DailyBMSReturn_" & Format(Now(), "yyyy-mm-dd") &
".xls"
'copyModule
Sheets("DailyCallStats").Select
Sheets("Instructions").Activate
Sheets("DailyCallStats").Copy
DeleteAllCode
'===== new code to paste values
Sheets("DailyCallStats").Select
Sheets("DailyCallStats").Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Sheets("DailyCallStats").Range("A1").Select
'===== new code to paste values
ElseIf DorW = "W" Then
strFileName = "WeeklyBMSReturn_" & Format(Now(), "yyyy-mm-dd") &
".xls"
'copyModule
Sheets(Array("MailRtn", "LanguageRtn", "VDNRtn",
"HourlyCallStatsRtn")).Select
Sheets("Instructions").Activate
Sheets(Array("MailRtn", "LanguageRtn", "VDNRtn",
"HourlyCallStatsRtn")).Copy
DeleteAllCode
'===== new code to paste values
Sheets(Array("MailRtn", "LanguageRtn", "VDNRtn",
"HourlyCallStatsRtn")).Select
Sheets("MailRtn").Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Sheets("MailRtn").Range("A1").Select
'===== new code to paste values
End If
'Stop
ActiveWorkbook.SaveAs Filename:=strPath & strFileName,
FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False,
CreateBackup:=False
ActiveWorkbook.Close
For Each WkSheet In AllSheets
Sheets(WkSheet.Name).Activate
ActiveSheet.Protect Password:="Dub", DrawingObjects:=True,
Contents:=True, Scenarios:=True
Next WkSheet
'Windows(strFileName).Activate
'Windows(strWkBookName).Activate
End Sub
###################################################################
and not excel 2002 (WinXP)?
It creates a workbook, copies certain sheets accross, and then deletes
the code from the new workbook. And its giving me major hasle and the
client site. I have no means of testing with the same environment
here.
###################################################################
Option Explicit
Public strFileName As String
Public strPath As String
'
Public Sub DeleteAllCode()
On Error Resume Next
With ActiveWorkbook.VBProject
For x = .VBComponents.Count To 1 Step -1
.VBComponents.Remove .VBComponents(x)
Next x
For x = .VBComponents.Count To 1 Step -1
.VBComponents(x).CodeModule.DeleteLines _
1, .VBComponents(x).CodeModule.CountOfLines
Next x
End With
On Error GoTo 0
End Sub
Public Sub CreateEndUserBook(ByVal DorW As String)
Dim strWkBookName As String
strPath = ActiveWorkbook.Path
strPath = strPath & "\"
strWkBookName = ActiveWorkbook.Name
Dim WkSheet As Worksheet
Dim AllSheets As Sheets
Set AllSheets = Worksheets
'Stop
For Each WkSheet In AllSheets
Debug.Print WkSheet.Name
Sheets(WkSheet.Name).Activate
ActiveSheet.Unprotect Password:="Dub"
Next WkSheet
If DorW = "D" Then
strFileName = "DailyBMSReturn_" & Format(Now(), "yyyy-mm-dd") &
".xls"
'copyModule
Sheets("DailyCallStats").Select
Sheets("Instructions").Activate
Sheets("DailyCallStats").Copy
DeleteAllCode
'===== new code to paste values
Sheets("DailyCallStats").Select
Sheets("DailyCallStats").Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Sheets("DailyCallStats").Range("A1").Select
'===== new code to paste values
ElseIf DorW = "W" Then
strFileName = "WeeklyBMSReturn_" & Format(Now(), "yyyy-mm-dd") &
".xls"
'copyModule
Sheets(Array("MailRtn", "LanguageRtn", "VDNRtn",
"HourlyCallStatsRtn")).Select
Sheets("Instructions").Activate
Sheets(Array("MailRtn", "LanguageRtn", "VDNRtn",
"HourlyCallStatsRtn")).Copy
DeleteAllCode
'===== new code to paste values
Sheets(Array("MailRtn", "LanguageRtn", "VDNRtn",
"HourlyCallStatsRtn")).Select
Sheets("MailRtn").Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Sheets("MailRtn").Range("A1").Select
'===== new code to paste values
End If
'Stop
ActiveWorkbook.SaveAs Filename:=strPath & strFileName,
FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False,
CreateBackup:=False
ActiveWorkbook.Close
For Each WkSheet In AllSheets
Sheets(WkSheet.Name).Activate
ActiveSheet.Protect Password:="Dub", DrawingObjects:=True,
Contents:=True, Scenarios:=True
Next WkSheet
'Windows(strFileName).Activate
'Windows(strWkBookName).Activate
End Sub
###################################################################