Set title block drawing no to = browser sheet name

[Anonymous]

I have some code that steps through the browser sheet names and allows you to set them. I would like to be able to be able to set the Drawing No. in each sheet title box as well.

I have pasted my code below it works for setting the browser names but only sets the active sheet title block drawing no.

I have highlighted where I believe the problem to be.

Any help with this matter would be gratefully received.

SyntaxEditor Code Snippet

Dim oDrawDoc As DrawingDocument
Dim tb As Inventor.TextBox
Dim oBorder As Border
Dim borderDef As BorderDefinition
Dim oTB1'oTB1 references to Titleblocks
Dim sValue As String
Dim oDrwNo 
Dim oPromptEnt As String
Dim oSheet As Sheet
Dim SheetNumber As String
Dim SheetNameChange As String
oDrawDoc = ThisApplication.ActiveDocument
oSheet = oDrawDoc.ActiveSheet
oBorder = oSheet.Border
borderDef = oBorder.Definition
oTB1 = oSheet.TitleBlock
i = 1

On Error Resume Next
    'oUseSheetNo = InputRadioBox("Use 'Sheet No.' in Drawing No.", "With Sheet No.", "Without Sheet No.", True, Title := "Use Sheet NO.")
        For Each oSheet In ThisApplication.ActiveDocument.Sheets
        SheetNumber  = Mid(oSheet.Name, InStr(1, oSheet.Name,":") + 1)
        SheetName = oSheet.Name
        'MessageBox.Show( oSheet.Name)
        
        
        SheetNameChange = InputBox("Is this the Sheet Name You Want??", "Set Sheet Name.", SheetName,)
        'SheetNameChange = InputBox("Is this the Sheet Name You Want??", "Set Sheet Name.", SheetName,XPos:=14, YPos:=7)
        'MessageBox.Show(SheetNameChange, "Title")
        
        
        oSheet.Name = SheetNameChange
        'MessageBox.Show(SheetNumber, oSheet.Name)
        
        For Each tb In oDrawDoc.ActiveSheet.TitleBlock.Definition.Sketch.TextBoxes 
            If tb.Text = "DRAWING NO." Then
                        sValue = oTB1.GetResultText(tb)
                        oDrwNo = SheetNameChange
                        'MessageBox.Show("Property Field: " & tb.Text & vbCrLf & "Value: " & sValue & vbCrLf & "Prompted Entry: " & tb.FormattedText, "Prompted entry")        
                        'MessageBox.Show("Param drw no  " & oDrwNo, "Title")
            Call oDrawDoc.ActiveSheet.TitleBlock.SetPromptResultText(tb, oDrwNo) 
                        oPromptEnt = oTB1.GetResultText(tb)
                        'MessageBox.Show("Prompted value " & oPromptEnt, "Title")
        

    End If
        i=1+1
        Next
    Next
    

[naresh_kalyan]

Hi Vancem,

Add the line as shown below

For Each oSheet In ThisApplication.ActiveDocument

osheet.Activate

~NK

[Anonymous · Accepted solution]

Thank you for your response I am away from my computer at the moment but will look at it asap.

Regards,

Vance Murphy

Check out our Web Page: www.hde.com.au

[cid:image002.png@01CEBA8A.9C0C2D60]
Shop 2/74 Egerton Street, PO BOX 1973 Emerald QLD 4720
Ph: (07) 49876 303 | Fax: (07) 49876 302 | Mobile: 0439302019
Email: Vance.Murphy@hde.com.au

[Anonymous]

Thank you for your solution it works beautifully.