R
Rich_z
I have an application that adds worksheets as required by the user.
This includes various graphics objects etc using the following code:
Code:
--------------------
Sub Create_Sheet(Sheet_Name As String)
'*
Dim Which_Arrow As String
'*
Application.EnableEvents = False
Application.ScreenUpdating = False
Sheets.Add.Move after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Sheet_Name
Sheets("Stand.Bound.Wall").Activate
Call Unlock_Sheet("")
'*
'* Find out which direction of lay arrow is invisible and make
'* it visible so it's included in the copy...
'*
If Not ActiveSheet.Shapes(c_Dol_Right_Arrow).Visible Then
Which_Arrow = c_Dol_Right_Arrow
Else
Which_Arrow = c_Dol_Left_Arrow
End If
ActiveSheet.Shapes(Which_Arrow).Visible = True
Cells.Select
Selection.Copy
Sheets(Sheet_Name).Select
ActiveSheet.Paste
ActiveSheet.Shapes(Which_Arrow).Visible = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Stand.Bound.Wall").Select
ActiveSheet.Shapes(Which_Arrow).Visible = False
Call Lock_Sheet
Sheets(Sheet_Name).Activate
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
--------------------
This works fine, however, it does not copy the macros from the source
sheet such as :
Code:
--------------------
Private Sub Worksheet_Activate()
Call Gutter_Activate(ActiveSheet)
End Sub
'*
Private Sub Worksheet_Change(ByVal Target As Range)
Call Gutter_Change(ActiveSheet, Target)
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call Gutter_SelectionChange(ActiveSheet, Target)
End Sub
--------------------
As you can see, the macros themselves are just calls to the actual
routines in a VBA module.
Also what needs to be copied are some custom properties such as:
Code:
--------------------
Public Property Get Angle_R() As Double
Angle_R = Range(Angle_R_Address()).Value
End Property
Public Property Let Angle_R(New_Value As Double)
Range(Angle_R_Address()).Value = New_Value
End Property
Public Property Get Angle_S() As Double
Angle_S = Range(Angle_S_Address()).Value
End Property
Public Property Let Angle_S(New_Value As Double)
Range(Angle_S_Address()).Value = New_Value
End Property
--------------------
What is the best way of achieving a complete clone of the worksheet
including all macros etc?
Regards
Rich
This includes various graphics objects etc using the following code:
Code:
--------------------
Sub Create_Sheet(Sheet_Name As String)
'*
Dim Which_Arrow As String
'*
Application.EnableEvents = False
Application.ScreenUpdating = False
Sheets.Add.Move after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Sheet_Name
Sheets("Stand.Bound.Wall").Activate
Call Unlock_Sheet("")
'*
'* Find out which direction of lay arrow is invisible and make
'* it visible so it's included in the copy...
'*
If Not ActiveSheet.Shapes(c_Dol_Right_Arrow).Visible Then
Which_Arrow = c_Dol_Right_Arrow
Else
Which_Arrow = c_Dol_Left_Arrow
End If
ActiveSheet.Shapes(Which_Arrow).Visible = True
Cells.Select
Selection.Copy
Sheets(Sheet_Name).Select
ActiveSheet.Paste
ActiveSheet.Shapes(Which_Arrow).Visible = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Stand.Bound.Wall").Select
ActiveSheet.Shapes(Which_Arrow).Visible = False
Call Lock_Sheet
Sheets(Sheet_Name).Activate
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
--------------------
This works fine, however, it does not copy the macros from the source
sheet such as :
Code:
--------------------
Private Sub Worksheet_Activate()
Call Gutter_Activate(ActiveSheet)
End Sub
'*
Private Sub Worksheet_Change(ByVal Target As Range)
Call Gutter_Change(ActiveSheet, Target)
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call Gutter_SelectionChange(ActiveSheet, Target)
End Sub
--------------------
As you can see, the macros themselves are just calls to the actual
routines in a VBA module.
Also what needs to be copied are some custom properties such as:
Code:
--------------------
Public Property Get Angle_R() As Double
Angle_R = Range(Angle_R_Address()).Value
End Property
Public Property Let Angle_R(New_Value As Double)
Range(Angle_R_Address()).Value = New_Value
End Property
Public Property Get Angle_S() As Double
Angle_S = Range(Angle_S_Address()).Value
End Property
Public Property Let Angle_S(New_Value As Double)
Range(Angle_S_Address()).Value = New_Value
End Property
--------------------
What is the best way of achieving a complete clone of the worksheet
including all macros etc?
Regards
Rich