[Registry]
Root: HKCU; Subkey: "Software\VisaCreator"; ValueType: string; ValueName: "InstallPath"; ValueData: "{app}"

Function Read_INI()
Dim s As String
    Key$ = "HKEY_CURRENT_USER\Software\VisaCreator\InstallPath"
       s = CreateObject("WScript.Shell").RegRead(Key$)
   MsgBox s
End Function

Function Read_INI() 
Open "C:\Windows\visacreate.ini" For Input As #1 
Dim s As Variant
Input #1, s 
MsgBox s 
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
End Sub 

Worksheets("List1").Protect Password:="555", UserInterfaceOnly:=True

Application.Wait (Now + TimeValue("0:00:02")) 
Worksheets("List1").Protect Password:="555", UserInterfaceOnly:=True

Private Sub Worksheet_Change(ByVal Target As Range)

Worksheets("List1").Protect Password:="555"

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Worksheets("List1").Unprotect Password:="555"
'много ячеек подверженных изменению
    Set KeyCells = Range("B1")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
    Is Nothing Then
'необходимые действия    
    Set KeyCells = Range("B2")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
    Is Nothing Then
'необходимые действия
'и так далее
Worksheets("List1").Protect Password:="555"
End Sub

 'Заполняем поля посещения стран автоматически
Private Sub Worksheet_Change(ByVal Target As Range)
    Set KeyCells = Range("A2")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
    Is Nothing Then
Application.ScreenUpdating = False
 
    Dim str As String
    Dim i As Long
    For i = 0 To Range("A2").Count - 1
        If Range("A2").Select Then
          str = str & Range("A2").Value & ", "
        End If
     Next
     If Len(Range("A3").Value & str) < 50 Then
        Range("A3").Value = Range("A3").Value & str
     ElseIf Len(Range("A4").Value & str) < 50 Then
        Range("A4").Value = Range("A4").Value & str
     End If
End If

    'Заполняем поля посещения стран автоматически
Private Sub Worksheet_Change(ByVal Target As Range)
    Set KeyCells = Range("A2")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
    Is Nothing Then
Application.ScreenUpdating = False

    Dim str As String
    Dim i As Long
    For i = 0 To Range("A2").Count - 1
        If Range("A2").Select Then
          str = str & Range("A2").Value & ", "
        End If
     Next
        Range("A3").Value = Range("A3").Value & str
   End If
End Sub

If ActiveWorkbook.Names("Рисунок")="" Then
Exit Sub
Else 
ActiveWorkbook.Names("Рисунок").Delete
End If

On Error Resume Next

Me.OLEObjects("X" & i).Object.Value = True 

  Dim i As Long
    For i = 1 To 4
        If Me.OLEObjects("X" & i).Object.Value = True Then
        Range("A20").Value = i
      End If
    Next

    Dim i As Long
    For i = 1 To 4
        If Me.OLEObjects("X" & i).Object.Value = False Then
        Range("A20").Value = i
      End If
    Next