Как присвоить новое имя?

[pingvi]

word 2003 встроенный vba
надо создать 2 новых property и присвоить им определенные значения. которые бы изменялись автамотически при вводе в код других значений

Sub SetProperty(name As String, propValue As String)

ActiveDocument.CustomDocumentProper ties("Test1").Value = "Name1"
ActiveDocument.CustomDocumentProper ties("Test2").Value = "Name2"
// присваиваем значения property

надо написать так что бы обновлялось автвмотически например при замене "name1" на "kjhgf23"

End Sub

Sub AddProperty(name As String)

Dim objCustomProperties As DocumentProperties
Set objCustomProperties = ActiveDocument.CustomDocumentProper ties

objCustomProperty.Add name:="Test1", _
Type:=msoPropertyTypeString, Value:="Name1", _
LinkToContent:=False
// создаем новый property пишет ошибку, хотя новый property с именет test1 создает почему не понимаю

objCustomProperties.Add name:="Test2", _
Type:=msoPropertyTypeString, Value:="Name2", _
LinkToContent:=False


End Sub

Function GetProperty(name As String) As String
Dim str As String

str = ActiveDocument.CustomDocumentProper ties(name).Value = "Name1"
Debug.Print name & " = " & str

str = ActiveDocument.CustomDocumentProper ties(name).Value = "Name2"
Debug.Print name & " = " & str

End Function

Sub UpdateFields()

ActiveDocument.Fields.Update

End Sub


Sub Test()
AddProperty "Test1"
SetProperty "test1", "value1"

AddProperty "Test2"
SetProperty "test2", "value2"


End Sub

прошу помогите, я только учусь

[viter.alex]

'Добавление свойства
Public Sub AddProperty(sPropName As String)
  Dim objCustomProperties As DocumentProperties
  Dim retval As Variant
  Set objCustomProperties = ActiveDocument.CustomDocumentProperties
  
  On Error Resume Next
  'Попытка прочитать свойство с заданным именем
  retval = objCustomProperties(sPropName).Value
  
  'Если возникла ошибка, т.е. такое свойство не существует, _
  то создание нового свойства
  If Err.Number = 5 Then
    objCustomProperties.Add sPropName, False, msoPropertyTypeString, ""
    Err.Clear
  End If
End Sub

'Задание значение свойств
Public Sub SetProperty(ByVal sPropName As String, ByVal sValue As String)
  Dim objCustomProperties As DocumentProperties
  Dim retval As Variant
  Set objCustomProperties = ActiveDocument.CustomDocumentProperties
  
  On Error Resume Next
  'Попытка задать значение свойства с заданным именем
  objCustomProperties(sPropName).Value = sValue
  
  'Если возникла ошибка, т.е. такое свойство не существует, _
  то просто очищаем ошибку
  If Err.Number = 5 Then Err.Clear
End Sub

'Получение свойств
Public Function GetProperty(ByVal sPropName As String) As String
  Dim objCustomProperties As DocumentProperties
   Dim retval As Variant
  Set objCustomProperties = ActiveDocument.CustomDocumentProperties
  
  On Error Resume Next
  'Попытка задать свойство с заданным именем
  GetProperty = objCustomProperties(sPropName).Value
  
  'Если возникла ошибка, т.е. такое свойство не существует, _
  то просто очищаем ошибку
  If Err.Number = 5 Then Err.Clear
End Function

'Пример использования
Sub test()
  AddProperty "ttt"
  SetProperty "ttt", "value"
  MsgBox GetProperty("ttt")
End Sub

Для обновления полей отдельная процедура мне кажется излишней

[pingvi]

viter.alex спасибо большое за помощь
у меня еще один вопрос
все работает и создаеться
но нельзя ли что бы на экран (после запуска программы) выводилось что-то типа
Test1 = Name1
Test2 = Name2
и все это в одном окошке?

Sub AddProperty(sPropName As String)
Dim str As Variant
Dim objCustomProperties As DocumentProperties
Set objCustomProperties = ActiveDocument.CustomDocumentProper ties

str = objCustomProperties("Test1").Value
str = objCustomProperties("Test2").Value

End Sub


Sub SetProperty(sPropName As String, sValue As String)
Dim objCustomProperties As DocumentProperties
Set objCustomProperties = ActiveDocument.CustomDocumentProper ties

objCustomProperties("Test1").Value = "Name1"
objCustomProperties("Test2").Value = "Name2"
// думаю что лошусь я где-то здесь
End Sub

Public Function GetProperty(sPropName As String) As String
Dim objCustomProperties As DocumentProperties
Set objCustomProperties = ActiveDocument.CustomDocumentProper ties

GetProperty = objCustomProperties("Test1").Value
GetProperty = objCustomProperties("Test2").Value

End Function
Sub UpdateFields()

ActiveDocument.Fields.Update

End Sub

Sub Test()
AddProperty "Test1"
SetProperty "Test1", "Name1"
MsgBox GetProperty("Test1")

End Sub

если вам сложно или просто лень отвлекаться на такую ерунду, то подскажите литературку которая даже тупому новичку подробно все разжует)
заранее спасибо

[viter.alex]

Возвращаясь к тому, что я написал, это будет так:

'Пример использования
Sub test()
  AddProperty "test1"
  SetProperty "test1", "Name1"
  AddProperty "test2"
  SetProperty "test2", "Name2"
  MsgBox "test1" & " = " & GetProperty("test1") & vbCr & _
         "test2" & " = " & GetProperty("test2")
End Sub

[pingvi]

опять спасибо и еще вопрос последний

почему
test1 = name2
test2= name2

как присвоить значение name1 для test1 ?

[viter.alex]

Думать, думать и ещё раз думать

[pingvi]

Sub SetProperty(sPropName As String, sValue As String)
Dim objCustomProperties As DocumentProperties
Set objCustomProperties = ActiveDocument.CustomDocumentProper ties

objCustomProperties("Test1").Value = "Name1"
objCustomProperties("Test2").Value = "Name2"
// думаю что лошусь я где-то здесь
End Sub

[viter.alex]

Книги по VBA для Word
Особое внимание книге Марка Розенберга

[pingvi]

спасибо разобрался тема закрыта