Public vis As Object
Public exl As Object
Public license As String

Private Sub Form_Load()
'обработка ошибок
On Error Resume Next
'ссылка на объекты ексель и визио (должны быть открыты) можно сделать по другому,
' но пока неохота
Set vis = GetObject(, "Visio.Application")
Set exl = GetObject(, "Excel.Application")

'определение пути к адд-он, для указания пути к файлу vss
Dim patt
patt = App.Path
If Right(patt, 1) = "\" Then
Else
patt = patt & "\"
End If
'подсчет количества заполненных столбцов и строк в ексель
exl.Range("A1").Select
Dim stolb
Dim strok
Dim znach

stolb = 0
1:
znach = exl.ActiveCell.Text

If znach = "" Then

Else
stolb = stolb + 1
exl.ActiveCell.Offset(0, 1).Range("A1").Select
GoTo 1
End If


exl.Range("A1").Select
strok = 0
2:
znach = exl.ActiveCell.Text

If znach = "" Then

Else
strok = strok + 1
exl.ActiveCell.Offset(1, 0).Range("A1").Select
GoTo 2
End If
'задание значений по умолчанию
Dim vssz
Dim shpz
Dim iksz
Dim igrz

vssz = "electrics.vss"
shpz = "Розетка"
iksz = 0
igrz = 0

Dim vss
Dim shp
Dim iks
Dim igr
'считывание имен (первая строка ексель)
Dim name_i(1 To 100)
exl.Range("A1").Select
For i = 1 To stolb
name_i(i) = exl.ActiveCell.Text
exl.ActiveCell.Offset(0, 1).Range("A1").Select
Next i
'поиск нестандартных идентефикаторов
vss = 0 '- если не указан vss
shp = -1 '- если не указан шейп
iks = -2 '-  если нет координаты х
igr = -3 '- если нет координаты y
For i = 1 To stolb
'файл vss
If name_i(i) = "vss" Then vss = i
'шейп (shape)
If name_i(i) = "shape" Then shp = i
' координату x
If name_i(i) = "x" Then iks = i
'координату y
If name_i(i) = "y" Then igr = i
Next i

Dim data_i(1 To 100, -3 To 100)

    For j = 1 To strok - 1
    data_i(j, 0) = vssz
    data_i(j, -1) = shpz
    data_i(j, -2) = iksz
    data_i(j, -3) = igrz
    
    Next j


'считывание значений из остальных ячеек ексель
exl.Range("A2").Select
For j = 1 To strok - 1
    For i = 1 To stolb

    data_i(j, i) = exl.ActiveCell.Text

    exl.ActiveCell.Offset(0, 1).Range("A1").Select
    Next i
exl.ActiveCell.Offset(1, -stolb).Range("A1").Select
Next j
'определение переменной "выделенный шейп"
    Dim vsoSelection As Visio.Selection

Dim iii
Dim mnog ' на это делим при переводе из мм в дюймы
iii = 0
'вставка шейпов
For j = 1 To strok - 1

Text1.Text = data_i(j, shp) ' используем текстовое окно формы
'так-как .Masters.Item(Text1.Text) не понимает переменных в VB, а в VBA понимает идиот. 
'обработка координаты х
' замена миллиметров на дюймы
mnog = 1
iii = iii + InStr(1, data_i(j, iks), "mm")
iii = iii + InStr(1, data_i(j, iks), "мм")
If iii > 0 Then mnog = 25.4
data_i(j, iks) = Replace(data_i(j, iks), "mm", "")
data_i(j, iks) = Replace(data_i(j, iks), "мм", "")
' замена сантиметров на дюймы
iii = 0
iii = iii + InStr(1, data_i(j, iks), "sm")
iii = iii + InStr(1, data_i(j, iks), "см")
If iii > 0 Then mnog = 2.54
data_i(j, iks) = Replace(data_i(j, iks), "sm", "")
data_i(j, iks) = Replace(data_i(j, iks), "см", "")
' замена метров на дюймы
iii = 0
iii = iii + InStr(1, data_i(j, iks), "m")
iii = iii + InStr(1, data_i(j, iks), "м")
If iii > 0 Then mnog = 0.0254
data_i(j, iks) = Replace(data_i(j, iks), "m", "")
data_i(j, iks) = Replace(data_i(j, iks), "м", "")
'убираем лишнее
If Right(data_i(j, iks), 1) = "." Then _
data_i(j, iks) = Left(data_i(j, iks), Len(data_i(j, iks)) - 1)
data_i(j, iks) = RTrim(data_i(j, iks))
data_i(j, iks) = LTrim(data_i(j, iks))
'заменяем точку на запятую

data_i(j, iks) = Replace(data_i(j, iks), ".", ",")

'делаем из строки число и переводим в дюймы
data_i(j, iks) = data_i(j, iks) / mnog

'обработка координаты y
' замена миллиметров на дюймы
mnog = 1
iii = 0
iii = iii + InStr(1, data_i(j, igr), "mm")
iii = iii + InStr(1, data_i(j, igr), "мм")
If iii > 0 Then mnog = 25.4
data_i(j, igr) = Replace(data_i(j, igr), "mm", "")
data_i(j, igr) = Replace(data_i(j, igr), "мм", "")
' замена сантиметров на дюймы
iii = 0
iii = iii + InStr(1, data_i(j, igr), "sm")
iii = iii + InStr(1, data_i(j, igr), "см")
If iii > 0 Then mnog = 2.54
data_i(j, igr) = Replace(data_i(j, igr), "sm", "")
data_i(j, igr) = Replace(data_i(j, igr), "см", "")
' замена метров на дюймы
iii = 0
iii = iii + InStr(1, data_i(j, igr), "m")
iii = iii + InStr(1, data_i(j, igr), "м")
If iii > 0 Then mnog = 0.0254
data_i(j, igr) = Replace(data_i(j, igr), "m", "")
data_i(j, igr) = Replace(data_i(j, igr), "м", "")
'убираем лишнее
If Right(data_i(j, igr), 1) = "." Then _
data_i(j, igr) = Left(data_i(j, igr), Len(data_i(j, igr)) - 1)
data_i(j, igr) = RTrim(data_i(j, igr))
data_i(j, igr) = LTrim(data_i(j, igr))
'заменяем точку на запятую
data_i(j, igr) = Replace(data_i(j, igr), ".", ",")
'делаем из строки число
data_i(j, igr) = data_i(j, igr) / mnog



'вставка элемента
    vis.Application.ActiveWindow.Page.Drop vis.Application.Documents.Item _
   (patt & data_i(j, vss)).Masters.Item(Text1.Text), data_i(j, iks), data_i(j, igr)
    Set vsoSelection = vis.ActiveWindow.Selection
'вот тут-то и присваевается значение в соответствии с именем ячейки в шейплисте
'если такой ячейки нет, то ничего не вставляется
For i = 1 To stolb
vsoSelection.Item(1).Cells(name_i(i)).FormulaU = data_i(j, i)
Next i
Next j

'выгружаем форму, она нужно была только для text1
Unload Form1

End Sub