Is it possible to assign dynamic text in a shape?

[Epon]

I am designing Windows User Interface in VISIO EA using Windows & Dialog
Stencils.
The designs are Multi Language Supported (1 Control to many captions).
What I am doing is just to copy a total design to another page (within a
current vsd file) and re-set the text manually. Since the design is large,
copying a whole would double the workforce, output and also make confusion to
developers.

Is it possible to program visio to dynamically look for a text set
externally like Global Resources in VS.NET? (e.g. having a button in every
page and change every text when clicked?)

Thank you all,

 

[JuneTheSecond]

I think you can do to exchange texts for all shapes.
To assist it, all shapes might need any key data in user defied cells or in
their name.
or you could identufy by the texts themselves.
and then you do loop for all shapes to define texts.

 

[Epon]

Thank you JuneTheSecond,

Here is a code I just gathered from many places:
--------------------------------------------------------
Private Sub ExportShapeName_Click() 'generate excel
file with exact pages & controls in visio
Dim objApp As Excel.Application
Dim objBook As Excel.Workbook
Dim objSheet As Excel.Worksheet
Dim objRange As Excel.Range
Dim shps As Visio.Shapes
Dim shp As Visio.Shape
Dim i, j, p As Integer

On Error GoTo errs1
Set objApp = New Excel.Application 'initialize
1 excel application, 1 workbook, and 1 worksheet
objApp.Visible = True
Set objBook = objApp.Workbooks.Add
Set objSheet = objBook.Worksheets.Add
While objBook.Worksheets.count > 1 'remove
sheet2,sheet3 created in excel by default
objBook.Worksheets(1).Delete
Wend

On Error GoTo errs2
For p = 1 To ThisDocument.Pages.count 'start loop at
first page in visio

Set objSheet = objBook.Worksheets(p) 'start loop at
first page in excel
Set objSheet = objApp.ActiveSheet
objSheet.Name = ThisDocument.Pages(p).Name

objSheet.Cells(1, 1).Value = "Shape ID" 'column header
objSheet.Cells(1, 2).Value = "DisplayName EN"
objSheet.Cells(1, 3).Value = "DisplayName TH"
objSheet.Cells(1, 4).Value = "Shape UID"
objSheet.Columns(2).ColumnWidth = 40
objSheet.Columns(3).ColumnWidth = 40
objSheet.Columns(4).ColumnWidth = 20
objSheet.Rows(1).Font.Bold = True

Set shps = ThisDocument.Pages(p).Shapes 'start loop at
first shape in each page sorted by created date
j = 2
For i = 1 To shps.count
Set shp = shps(i)
If Len(CStr(shp.ID)) > 0 Then
If Len(shp.Text) > 0 Then
objSheet.Cells(j, 1).Value = CStr(shp.ID) 'export
value to excel
objSheet.Cells(j, 2).Value = shp.Text
objSheet.Cells(j, 4).Value = shp.NameU
j = j + 1
End If
End If
Set shp = Nothing
Next
Set shps = Nothing
Set objSheet = objBook.Worksheets.Add(After:=objBook.Worksheets(p))
Next

objApp.DisplayAlerts = False
objBook.Worksheets(objBook.Worksheets.count).Delete
objApp.DisplayAlerts = True
Set objBook = Nothing
Set objApp = Nothing

Exit Sub

errs1:
MsgBox ("Excel initialization eror, Please try again.")
Exit Sub

errs2:
MsgBox ("error at" + CStr(shp.ID) + "," + shp.Text + "," +
CStr(Len(shp.Text)) + "," + shp.NameU + "\n" + " Please try again.")
Exit Sub

End Sub
-----------------------------------------------------------
Private Sub ImportGR_Click()
Dim shp As Visio.Shape

On Error GoTo errs
Set shp = Application.ActivePage.InsertFromFile(Trim(FilePath.Text),
visInsertAsEmbed) 'open excel file from specific path/filename
shp.Name = xlShapeName
'every worksheets in excel will be
placed at first page in visio
shp.Cells("FillPattern") = 1
shp.Cells("FillForegnd") = 1
shp.Cells("FillBkgnd") = 1
ThisDocument.SwitchLanguage.Enabled = True

Exit Sub
errs:
MsgBox ("invalid File Path or file not found")
ThisDocument.SwitchLanguage.Enabled = False
End Sub
--------------------------------------------------------------
Private Sub SwitchLanguage_Click()
Dim objBook As Excel.Workbook
Dim objSheet As Excel.Worksheet
Dim shp As Visio.Shape
Dim i, j, p, c As Integer

c = ThisDocument.Pages(1).Shapes(xlShapeName).Object.Worksheets.count
If (ThisDocument.SwitchLanguage.Caption = "English") Then
' from Alternate language to English
For p = 1 To c
'start loop at first page
in excel
Set objSheet =
ThisDocument.Pages(1).Shapes(xlShapeName).Object.Worksheets(p)
For i = 2 To objSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
'start loop at second row in excel to last row
containing data
Set shp =
ThisDocument.Pages(p).Shapes.ItemFromID(objSheet.Cells(i, 1))
If Len(CStr(shp.ID)) > 0 Then
If Len(shp.Text) > 0 Then
shp.Text = objSheet.Cells(i, 2).Value
End If
End If
Next
Next
ThisDocument.SwitchLanguage.Caption = "Alternate Language)"
Else:
'from english to
Alternate
For p = 1 To c
Set objSheet =
ThisDocument.Pages(1).Shapes(xlShapeName).Object.Worksheets(p)
For i = 2 To objSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
Set shp =
ThisDocument.Pages(p).Shapes.ItemFromID(objSheet.Cells(i, 1))
If Len(CStr(shp.ID)) > 0 Then
If Len(shp.Text) > 0 Then
shp.Text = objSheet.Cells(i, 3).Value
End If
End If
Next
Next
ThisDocument.SwitchLanguage.Caption = "English"
End If

End Sub