Mark,
Let's walk through it step-by-step so you can get what you want out of this.
We start in SheetSetForm.SSStartHere.
This is checking to see if you have a sheet set open and make sure only one is open.
It will lock it then send it on to LoopThroughSheetsPop
Here is where we get the values to present to the user for changing.
Notice that GetCSSProperties is sending a string and a sheet. The string is the EXACT Title of the Custom Sheet Property.
You can customize the whole form according to your company's custom sheet properties.
Let's assume some values were changed and the user hits the OK button. That code send us to SetProps.
This routine checks for one and only one sheet set and locks it.
Because this stuff is exporting sheet set stuff to Excel for import at another office we will skip that for now.
SetProps sends us to LoopThroughSheetsSet which will do just that.
It will loop through all of the sheets and set the values to what they are in the form. If the user didn't change them they still get 'updated' but nothing will change.
Private Sub LoopThroughSheetsSet(ByVal compEnum As IAcSmEnumComponent)
Dim comp As IAcSmComponent
Dim lastrevn As Variant
Dim lyOut As AcSmAcDbLayoutReference
Dim lyName As String
Dim lastrevd As String
Dim lastrevdate As String
Dim rNumTemp As String
Dim rnNext As String
Dim rnVar As Variant
Dim dirmade As Boolean
Dim tLine1 As String
Dim tLine2 As String
Dim tLine3 As String
Dim selsets As AcSmSheetSelSets
Dim selset As AcSmSheetSelSet
Dim tselset As AcSmSheetSelSet
Dim ssMade As Boolean
Dim ttitle As String
Dim repTemp As String
On Error GoTo ErrHandler
ssMade = False
Set comp = compEnum.Next()
dirmade = False
' loop through till the component is Nothing
Do While Not comp Is Nothing
'if the component is a sheet, then...
If comp.GetTypeName = "AcSmSheet" Then
'loop through all the sheets.
'Call LoopThroughSheetsPop(sset.GetSheetEnumerator)
Dim s As AcSmSheet
Set s = comp
Dim sNumber As String
Dim sTitle As String
sNumber = s.GetNumber
'tLine1 = GetCSSProperties("Drawing Title Line 1", s)
'tLine2 = GetCSSProperties("Drawing Title Line 2", s)
'tLine3 = GetCSSProperties("Drawing Title Line 3", s)
'If tLine1 = "%%032" Then
' tLine1 = ""
'End If
'If tLine2 = "%%032" Then
' tLine2 = ""
'End If
'If tLine3 = "%%032" Then
' tLine3 = ""
'End If
'If Not tLine1 = "" Then
' If Not tLine2 = "" Then
' If Not tLine3 = "" Then
' ttitle = tLine1 & " " & tLine2 & " " & tLine3
' Else
' ttitle = tLine1 & " " & tLine2
' End If
' Else
' If Not tLine3 = "" Then
' ttitle = tLine1 & " " & tLine3
' Else
' ttitle = tLine1
' End If
' End If
'Else
' If Not tLine2 = "" Then
' If Not tLine3 = "" Then
' ttitle = tLine2 & " " & tLine3
' Else
' ttitle = tLine2
' End If
' Else
' If Not tLine3 = "" Then
' ttitle = tLine3
' End If
' End If
'End If
'
'If Not ttitle = "" Then
' s.SetTitle ttitle
'End If
sTitle = s.GetTitle
Set lyOut = s.GetLayout
lyName = lyOut.ResolveFileName
If sNumber = dNum Then
If Not pstamp = "" Then
ChangeProperties "Preliminary Stamp", pstamp, s
End If
If Not pLines = "" Then
ChangeProperties "ProjectLayer", pLines, s
End If
If Not tLines = "" Then
ChangeProperties "TitleLayer", tLines, s
End If
If Not ssetName = "" Then
newSelSet.Add s
End If
If Not chk = "" Then
ChangeProperties "Checked By", chk, s
End If
If Not des = "" Then
ChangeProperties "Designed By", des, s
End If
If Not chrg = "" Then
ChangeProperties "In Charge Of", chrg, s
End If
If Not dwn = "" Then
ChangeProperties "Drawn By", dwn, s
End If
If Not scl = "" Then
ChangeProperties "Scale", scl, s
End If
If Not ptitle = "" Then
ChangeProperties "Location", ptitle, s
'ChangeProperties "Drawing Title Line 1", ptitle, s
End If
If Not repTxt = "" Then
repTemp = PropReplaceCombo.Column(0, PropReplaceCombo.ListIndex)
ChangeProperties repTemp, repTxt, s
End If
If Not rdesc = "" Then
If wipeClean = True Then
ChangeProperties "Revision Number 0", "0", s
ChangeProperties "Description of revision 0", rdesc, s
ChangeProperties "Date of Revision 0", rdate, s
ChangeProperties "Initials of Rev 0 Reviewer", rinit, s
ChangeProperties "Revision Number 1", "%%032", s
ChangeProperties "Description of Revision 1", "%%032", s
ChangeProperties "Date of Revision 1", "%%032", s
ChangeProperties "Initials of Rev 1 Reviewer", "%%032", s
ChangeProperties "Revision Number 2", "%%032", s
ChangeProperties "Description of Revision 2", "%%032", s
ChangeProperties "Date of Revision 2", "%%032", s
ChangeProperties "Initials of Rev 2 Reviewer", "%%032", s
ChangeProperties "Revision Number 3", "%%032", s
ChangeProperties "Description of Revision 3", "%%032", s
ChangeProperties "Date of Revision 3", "%%032", s
ChangeProperties "Initials of Rev 3 Reviewer", "%%032", s
ChangeProperties "Revision Number 4", "%%032", s
ChangeProperties "Description of Revision 4", "%%032", s
ChangeProperties "Date of Revision 4", "%%032", s
ChangeProperties "Initials of Rev 4 Reviewer", "%%032", s
Else
If GetCSSProperties("Date of Revision 4", s) = "%%032" Then
If GetCSSProperties("Date of Revision 3", s) = "%%032" Then
If GetCSSProperties("Date of Revision 2", s) = "%%032" Then
If GetCSSProperties("Date of Revision 1", s) = "%%032" Then
If GetCSSProperties("Date of Revision 0", s) = "%%032" Then
If rtype = "L" Then
ChangeProperties "Revision Number 0", "A", s
Else
ChangeProperties "Revision Number 0", "0", s
End If
ChangeProperties "Description of revision 0", rdesc, s
ChangeProperties "Date of Revision 0", rdate, s
ChangeProperties "Initials of Rev 0 Reviewer", rinit, s
Else
rNumTemp = GetCSSProperties("Revision Number 0", s)
If rtype = "L" Then
rnNext = AddLetter(rNumTemp)
Else
If IsNumeric(rNumTemp) Then
rnVar = rNumTemp
rnVar = rnVar + 1
rnNext = rnVar
Else
rnNext = "0"
End If
End If
ChangeProperties "Revision Number 1", rnNext, s
ChangeProperties "Description of Revision 1", rdesc, s
ChangeProperties "Date of Revision 1", rdate, s
ChangeProperties "Initials of Rev 1 Reviewer", rinit, s
End If
Else
rNumTemp = GetCSSProperties("Revision Number 1", s)
If rtype = "L" Then
rnNext = AddLetter(rNumTemp)
Else
If IsNumeric(rNumTemp) Then
rnVar = rNumTemp
rnVar = rnVar + 1
rnNext = rnVar
Else
rnNext = "0"
End If
End If
ChangeProperties "Revision Number 2", rnNext, s
ChangeProperties "Description of Revision 2", rdesc, s
ChangeProperties "Date of Revision 2", rdate, s
ChangeProperties "Initials of Rev 2 Reviewer", rinit, s
End If
Else
rNumTemp = GetCSSProperties("Revision Number 2", s)
If rtype = "L" Then
rnNext = AddLetter(rNumTemp)
Else
If IsNumeric(rNumTemp) Then
rnVar = rNumTemp
rnVar = rnVar + 1
rnNext = rnVar
Else
rnNext = "0"
End If
End If
ChangeProperties "Revision Number 3", rnNext, s
ChangeProperties "Description of Revision 3", rdesc, s
ChangeProperties "Date of Revision 3", rdate, s
ChangeProperties "Initials of Rev 3 Reviewer", rinit, s
End If
Else
rNumTemp = GetCSSProperties("Revision Number 3", s)
If rtype = "L" Then
rnNext = AddLetter(rNumTemp)
Else
If IsNumeric(rNumTemp) Then
rnVar = rNumTemp
rnVar = rnVar + 1
rnNext = rnVar
Else
rnNext = "0"
End If
End If
ChangeProperties "Revision Number 4", rnNext, s
ChangeProperties "Description of Revision 4", rdesc, s
ChangeProperties "Date of Revision 4", rdate, s
ChangeProperties "Initials of Rev 4 Reviewer", rinit, s
End If
Else
rNumTemp = GetCSSProperties("Revision Number 4", s)
If rtype = "L" Then
rnNext = AddLetter(rNumTemp)
Else
If IsNumeric(rNumTemp) Then
rnVar = rNumTemp
rnVar = rnVar + 1
rnNext = rnVar
Else
rnNext = "0"
End If
End If
ChangeProperties "Revision Number 0", GetCSSProperties("Revision Number 1", s), s
ChangeProperties "Description of revision 0", GetCSSProperties("Description of Revision 1", s), s
ChangeProperties "Date of Revision 0", GetCSSProperties("Date of Revision 1", s), s
ChangeProperties "Initials of Rev 0 Reviewer", GetCSSProperties("Initials of Rev 1 Reviewer", s), s
ChangeProperties "Revision Number 1", GetCSSProperties("Revision Number 2", s), s
ChangeProperties "Description of Revision 1", GetCSSProperties("Description of Revision 2", s), s
ChangeProperties "Date of Revision 1", GetCSSProperties("Date of Revision 2", s), s
ChangeProperties "Initials of Rev 1 Reviewer", GetCSSProperties("Initials of Rev 2 Reviewer", s), s
ChangeProperties "Revision Number 2", GetCSSProperties("Revision Number 3", s), s
ChangeProperties "Description of Revision 2", GetCSSProperties("Description of Revision 3", s), s
ChangeProperties "Date of Revision 2", GetCSSProperties("Date of Revision 3", s), s
ChangeProperties "Initials of Rev 2 Reviewer", GetCSSProperties("Initials of Rev 3 Reviewer", s), s
ChangeProperties "Revision Number 3", GetCSSProperties("Revision Number 4", s), s
ChangeProperties "Description of Revision 3", GetCSSProperties("Description of Revision 4", s), s
ChangeProperties "Date of Revision 3", GetCSSProperties("Date of Revision 4", s), s
ChangeProperties "Initials of Rev 3 Reviewer", GetCSSProperties("Initials of Rev 4 Reviewer", s), s
ChangeProperties "Revision Number 4", rnNext, s
ChangeProperties "Description of Revision 4", rdesc, s
ChangeProperties "Date of Revision 4", rdate, s
ChangeProperties "Initials of Rev 4 Reviewer", rinit, s
End If
ChangeRevProps rnNext, rdate, s
End If
End If
End If
ElseIf comp.GetTypeName = "AcSmSubset" Then
Dim sset As AcSmSubset
Set sset = comp
'loop through all the sheets.
Call LoopThroughSheetsSet(sset.GetSheetEnumerator)
End If
'next
Set comp = compEnum.Next()
Loop
GoTo Exit_Here
ErrHandler:
Select Case Err.Number
Case -2147467259
Err.Clear
Resume
Case Else
MsgBox Err.Number & ":" & Err.Description, vbOKOnly, "Error " & Err.Number
GoTo Exit_Here
End Select
Exit_Here:
End Sub
This is where the work is done.
Notice how it is calling ChangeProperties, sending the Property title as a string, the desired value, and the sheet.
If you go through and replace all "Revision Number 0" with the title of your Custom Sheet Property then run the SheetSetSheet.SSFormStart
you will see what it is doing.
Let me write a set of routines for you that will ask for the Custom Property you want to get the value for and ask you to change it via InputBoxes.