I try to compare the text in excel and visio, if the text match, then replace that visio text with a range of excel text. Do anybody have any experiment with that? any ideal will be a big help.
Thanks
Thanks
Dim c As Range ' Actually a single cell Dim s As Visio.Shape Dim sFind As String 'String to find Dim sReplacement As String 'Replacement string Dim i As Integer With Range("A1:A2") 'My location of ABC & DEF sFind = .Cells(1) For Each c In .Cells sReplacement = sReplacement & c.Text & Chr(10) Next c sReplacement = Left(sReplacement, Len(sReplacement) - 1) ' Remove last CR End With For Each s In vsApp.ActivePage.Shapes If s.Text = sFind Then s.Text = sReplacement Next s
Dim c As Range ' Actually a single cell Dim s As Visio.Shape Dim sFind As String 'String to find Dim sReplacement As String 'Replacement string Dim i As Integer With Range("A1:A2") 'My location of ABC & DEF sFind = .Cells(1) For Each c In .Cells sReplacement = sReplacement & c.Text & Chr(10) Next c sReplacement = Left(sReplacement, Len(sReplacement) - 1) ' Remove last CR End With For Each s In vsApp.ActivePage.Shapes If s.Text = sFind Then s.Text = sReplacement Next s
Dim c As Range ' A single cell Dim s As Visio.Shape Dim sFind As String ' String to find Dim sReplacement As String ' Replacement string Dim i As Integer ' Column index For i = 1 To Cells(1, 1).CurrentRegion.Columns.Count 'for each column With Range(Cells(1, i), Cells(1, i).End(xlDown)) 'with the data in the column sFind = .Cells(1) 'the first cel is what to look for sReplacement = "" For Each c In .Cells 'concatinate all of the cells in the column sReplacement = sReplacement & c.Text & Chr(10) Next c sReplacement = Left(sReplacement, Len(sReplacement) - 1) ' Remove last CR End With For Each s In vsApp.ActivePage.Shapes ' for each shape If s.Text = sFind Then s.Text = sReplacement ' if it has the text, then replace it Next s Next i
Dim c As Range ' A single cell Dim s As Visio.Shape Dim sFind As String ' String to find Dim sReplacement As String ' Replacement string Dim i As Integer ' Column index For i = 1 To Cells(1, 1).CurrentRegion.Columns.Count 'for each column With Range(Cells(1, i), Cells(1, i).End(xlDown)) 'with the data in the column sFind = .Cells(1) 'the first cel is what to look for sReplacement = "" For Each c In .Cells 'concatinate all of the cells in the column sReplacement = sReplacement & c.Text & Chr(10) Next c sReplacement = Left(sReplacement, Len(sReplacement) - 1) ' Remove last CR End With For Each s In vsApp.ActivePage.Shapes ' for each shape If s.Text = sFind Then s.Text = sReplacement ' if it has the text, then replace it Next s Next i
For i = 1 To Sheet2.Cells(1, 1).CurrentRegion.Columns.Count 'for each column With Range(sheet2.Cells(1, i), sheet.Cells(1, i).End(xlDown)) 'with the data in the column sFind = Cells(1)
Dim c As Range ' A single cell Dim s As Visio.Shape Dim sFind As String ' String to find Dim sReplacement As String ' Replacement string Dim i As Integer ' Column index For i = 1 To Cells(1, 1).CurrentRegion.Columns.Count 'for each column With Range(Cells(1, i), Cells(1, i).End(xlDown)) 'with the data in the column sFind = .Cells(1) 'the first cel is what to look for sReplacement = "" For Each c In .Cells 'concatinate all of the cells in the column sReplacement = sReplacement & c.Text & Chr(10) Next c sReplacement = Left(sReplacement, Len(sReplacement) - 1) ' Remove last CR End With For Each s In vsApp.ActivePage.Shapes ' for each shape If s.Text = sFind Then s.Text = sReplacement ' if it has the text, then replace it Next s Next i
For i = 1 To Sheet2.Cells(1, 1).CurrentRegion.Columns.Count 'for each column With Range(sheet2.Cells(1, i), sheet.Cells(1, i).End(xlDown)) 'with the data in the column sFind = Cells(1)
With Worksheets("TEXT") For i = 1 To .Cells(1, 1).CurrentRegion.Columns.Count 'for each column With .Range(.Cells(1, i), .Cells(1, i).End(xlDown)) 'with the data in the column sFind = .Cells(1) End With Next i End With
Comment