Sub CollectFormulas()
  Dim ws As Worksheet, cell As Range, fileNum As Integer, FilePath As String, fileContents As String, output As String, quoteText As String
  FilePath = "C:\Формулы.txt"
  fileNum = FreeFile()
  Open FilePath For Output As fileNum
  For Each ws In ActiveWorkbook.Worksheets
    For Each cell In ws.UsedRange
      If cell.HasFormula Then Print #fileNum, cell.FormulaLocal
    Next cell
  Next ws
  Close fileNum
  Open FilePath For Input As #1
  fileContents = Input$(LOF(1), #1)
  Close #1
  For i = 1 To Len(fileContents)
    If Mid(fileContents, i, 1) = """" Then
      quoteText = ""
      For j = i + 1 To Len(fileContents)
        If Mid(fileContents, j, 1) = """" Then
          i = j: Exit For
        Else
          quoteText = quoteText & Mid(fileContents, j, 1)
        End If
      Next j
      quoteText = Trim(quoteText)
      If InStr(output, quoteText) = 0 Then output = output & quoteText & vbNewLine
    End If
  Next i
  Open FilePath For Output As #1
  Print #1, output
  Close #1
End Sub

Sub CollectControls()
  Dim ws As Worksheet, shp As Shape, cht As ChartObject, cmt As Comment, FilePath As String
  FilePath = "C:\Controls.txt"
  Open FilePath For Output As #1
  For Each ws In ActiveWorkbook.Worksheets
  ' Проходим по всем элементам ActiveSheet.Shapes и собираем тексты
    For Each shp In ws.Shapes
      If shp.Type = msoFormControl Then
        Select Case TypeName(shp.ControlFormat)
          Case "CheckBox", "OptionButton", "GroupBox", "Button", "EditBox", "Label"
            If shp.ControlFormat.Value <> "" Then Print #1, shp.ControlFormat.Value
        End Select
      End If
    Next shp
  ' Проходим по всем элементам ActiveSheet.ChartObjects и собираем тексты
    For Each cht In ws.ChartObjects
      For Each shp In cht.Chart.Shapes
        If shp.Type = msoFormControl Then
          Select Case TypeName(shp.ControlFormat)
            Case "CheckBox", "OptionButton", "GroupBox", "Button", "EditBox", "Label"
              If shp.ControlFormat.Value <> "" Then Print #1, shp.ControlFormat.Value
          End Select
        End If
      Next shp
   Next cht
 ' Проходим по всем комментариям на листе и собираем тексты
   For Each cmt In ws.Comments
     If cmt.Text <> "" Then Print #1, cmt.Text
     Next cmt
   Next ws
 ' Проходим по всем комментариям в Range и собираем тексты
   For Each cmt In ActiveSheet.Comments
     If cmt.Text <> "" Then Print #1, cmt.Text
   Next cmt
   Close #1
End Sub

Sub TranslateValues()
  Dim ws As Worksheet, cell As Range, dict As Object, arr() As Variant, i As Long, j As Long
  Set dict = CreateObject("Scripting.Dictionary")
' Перебираем все листы в книге
  For Each ws In ThisWorkbook.Worksheets
    For Each cell In ws.UsedRange.Cells ' 1273
      Select Case VarType(cell.Value)
        Case vbDouble, vbString
          If Not IsNumeric(cell.Value) And cell.Value <> "" And Not dict.exists(cell.Value) Then
            dict.Add cell.Value, 1
          End If
      End Select
    Next cell
  Next ws
' Создаем отсортированный массив без дубликатов
  ReDim arr(0 To dict.Count - 1)
  i = 0
  For Each Key In dict.keys
    arr(i) = Key
    i = i + 1
  Next Key
' Записываем значения из массива в столбец A на листе "Translate"
  Set ws = ThisWorkbook.Worksheets("Translate")
  For i = 0 To UBound(arr)
    If Not IsNumeric(arr(i)) Then arr(i) = CStr(arr(i))
  Next i
  ws.Range("A1").Resize(UBound(arr) + 1, 1).Value = Application.Transpose(arr)
' Удаляем дубликаты, сортируем
  ws.Range("$A:$A").RemoveDuplicates Columns:=1, Header:=xlNo
  With ws.Sort
    .SortFields.Clear
    .SortFields.Add Key:=ws.Range("A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .SetRange ws.Range("A:A")
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With
End Sub