С этой придурью ёксельной и мне довелось столкнуться.
Первое: старые версии (про 2007-й просто ничего не знаю) сходят с ума сразу по нескольким пунктам, если количество заполненных колонок слегка переваливает за 200 (хотя декларируется возможность использования 256). Так что первое лекарство - удалить ненужные колонки или разнести инфу на отдельные листы.
Второе: (почти анекдот) есть кривая коза, на которой в данном случае можно-таки объехать эту всеми нежно любимую во все дыры сволочь, Билла Гейтса. Вы будете смеяться, но некоторые проперти примечаний влияют на ситуацию.
Deggasad , конечно, погорячился насчёт
удаления всех примечаний, можно обойтись и меньшей кровью.
Прошу покорно извинить, беру код из боевой таблицы безо всякой корректировки, но зерно истины, надеюсь, каждый заинтересованный сможет извлечь сам.
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
Private Sub SelectionCommentAutoSize()
Const msgTtl = "Авторазмер и привязка примечаний"
Dim oldAC As XlCalculation, oldASU As Boolean
Dim c As Range, r As Range
On Error GoTo ErrHandler
Set r = CommentedCells(Selection)
If Selection.Cells.Count <> 1 Then
If r Is Nothing Then
MsgBox "К выделенным ячейкам нет примечаний", _
vbInformation, msgTtl
Exit Sub
End If
ElseIf Selection.Comment Is Nothing Then
If MsgBox("На всем листе?", vbQuestion + vbOKCancel, _
msgTtl) <> vbOK Then Exit Sub
Else
Select Case MsgBox("Только в этой ячейке (ДА)" _
& vbCr & "или на всем листе (НЕТ)?", _
vbQuestion + vbYesNoCancel, msgTtl)
Case vbYes
Set r = Selection
Case vbCancel
Exit Sub
End Select
End If
oldASU = Application.ScreenUpdating
If oldASU Then Application.ScreenUpdating = False
oldAC = Application.Calculation
If oldAC <> xlCalculationManual _
Then Application.Calculation = xlCalculationManual
For Each c In r.Cells
With c.Comment.Shape
If .Top <= c.Top Or .Top >= c.Top + c.Height _
Then .Top = c.Top + c.Height / 2 #
If .Left <= c.Left Or .Left >= c.Left + c.Width _
Then .Left = c.Left + c.Width / 2 #
If .Placement <> xlMove Then .Placement = xlMove
If Not .TextFrame.AutoSize Then .TextFrame.AutoSize = True
End With
Next
If oldAC <> xlCalculationManual _
Then Application.Calculation = oldAC
If oldASU Then Application.ScreenUpdating = True
FinalInstructions:
Exit Sub
ErrHandler:
Application.ScreenUpdating = True
MsgBox Err.Description, vbCritical, msgTtl & ": ERROR #" & Err
Resume FinalInstructions
End Sub
