Задание размеров окна примечания.

[DID]

Здравствуйте.
Столкнулся с проблемой и очень надеюсь на помощь опытных людей. Есть цикл в котором переменная X является координатой ячейки в строке на листе Excel. Необходимо реализовать добавление поля комментария с конкретными размерами окна примечания. Метод

Selection.ShapeRange.ScaleWidth
Selection.ShapeRange.ScaleHeight

в данном случае не работает. Я думаю потому что в данном случае используется Cells, а не Range. Возможна ли работа с настройками параметров окна примечания при работе с Cells? Если же нет, как определить координаты активной ячейки в формате A1? Как ни бился, заставить Address (rowAbsolute, coluimAbsolute, referenceStyle, external, relativeTo) работать так как нужно у меня не вышло.
Заранее спасибо.

[VictorM]

DID,

как определить координаты активной ячейки в формате A1?

есть такой замечательный сайт http://www.msoffice.nm.ru
и вот цитата с этого сайта:

Код: Выделить всё

iAddress = ActiveCell.Address 
MsgBox iAddress

Для того чтобы убрать значение абсолютной ссылки $A$1 на строку и столбец нужно :

Код: Выделить всё

iAddress = ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)

там же можно почитать и о примечаниях.

[DID]

Спасибо!

[Pavel55]

можно записать короче )

Код: Выделить всё

iAddress = ActiveCell.Address(0, 0)

[DID]

С определением адреса ячейки разобрался. Еще раз спасибо. Но для решения моей проблемы это к сожалению ничего не дало. Я написал макрос в котором задаются размеры окна примечания. В нем естественно все работает... Вот текст макроса -

Range("B6").Select
Range("B6").AddComment
Range("B6").Comment.Visible = False
Range("B6").Comment.Text Text:="DID:" & Chr(10) & ""
Selection.ShapeRange.ScaleWidth 1.37, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.45, msoFalse, msoScaleFromTopLeft
Range("B6").Comment.Shape.Select True

А вот отрывок кода в котором мне необходимо использовать примечания с указанием размеров окна примечаний:

Worksheets("Лист6").Cells(2, x - 1).Select
If (Worksheets("Лист7").Cells(i, 4)) > 1 Then
Selection.Font.ColorIndex = 5
ActiveCell.AddComment
ActiveCell.Comment.Visible = False
ActiveCell.Comment.Text Text:=(Worksheets("Лист7").Cells(i, 4)) & " позиции"
Worksheets("Лист6").Cells(1, 1).Select
End If

Если добавить сюда Selection.ShapeRange.ScaleWidth то выдается ошибка на этой строке. Причем код по своей структуре практически аналогичен коду макроса...

HELP

[DID]

Может можно сделать проще - как-то реализовать подгонку размеров окна примечания автоматически по длине текста и количеству строк в примечании? Это был бы наверно самый оптимальный вариант...

[Pavel55]

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

Код: Выделить всё

Sub Размер_Комментарий()
Dim iComment As Comment
    For Each iComment In ActiveSheet.Comments
        iComment.Shape.TextFrame.AutoSize = True
        iComment.Shape.Height = iComment.Shape.Height + 10
        iComment.Shape.Width = iComment.Shape.Width + 15
    Next iComment
    MsgBox "Размеры комментарий исправлены!", vbInformation, "Комментарии"
End Sub

P.S. Please, используйте тэг

Код: Выделить всё

 для выделенения вашего кода. 

[b]Пример:[/b]

[code] [b]ВАШ КОД[/b] [./code]  - только без точки в последней скобке

[DID]

Большое спасибо! Все работает.

[Pavel55]

Если хотите я выложу примеры работы с комментариями (смена штрифта, его размер и т.д.)

[VictorM]

DID, ну а если применительно к Вашему выложенному коду, то он должен выглядеть приблизительно так

Код: Выделить всё

Worksheets("Лист6").Cells(2, x - 1).Select
iAddress = ActiveCell.Address(0, 0)
If (Worksheets("Лист7").Cells(i, 4)) > 1 Then
Selection.Font.ColorIndex = 5
With ThisWorkbook.Worksheets("Лист6").Range(iAddress)
.ClearComments 'удаляем старый коммент, если есть
     With .AddComment
          .Text Text:=(Worksheets("Лист7").Cells(i, 4)) & " позиции"
          With .Shape.TextFrame
                    .VerticalAlignment = xlVAlignCenter
                    .HorizontalAlignment = xlHAlignCenter
                    .Orientation = msoTextOrientationHorizontal
                    .AutoSize = True
          End With
     End With
End With
End If

p.s. а вообще-то я Вам давал ссылку, читайте! http://www.msoffice.nm.ru/faq/macros/co ... htm#faq117