Ранее была тема по работе с примечаниями http://www.planetaexcel.ru/forum/?FID=8&PAGE_NAME=read&TID=23225. В первом и последнем сообщении говорится о "преобразовании" стандартного значка примечания. Поскольку помещаю много важной информации в примечания, которую в расчеты никак не включишь, то это удобный способ обратить внимание на эту информацию. Беда в том, что расположенные фигуры (прямоугольники, треугольники или еще что), при наведении перехватывают фокус. За угол ячейки данные уже просто так не потянешь и когда документ проходит редактирование (не у автора), "колючки" фигур цепляются, фигуры переезжают, удаляются, часть данных для редакции так и остается не введенной. Выход вижу либо в защите фигурок от ручного доступа или в принудительном переводе фокуса на ячейку. Только как это сделать - не знаю. Если кто сталкивался, помогите
если мне не изменяет память, графические элементы и диаграммы и пр. расположены на отдельном слое, НАД ячейками. в свое время задавался похожим вопросом, посмотрите тут
Вот в примере координаты мышки надо, чтобы фигуры совсем не регистрировались, не выбирались. Работа должна вестись только с тем, что под фигурами. Наверняка, есть способ
Попробовал защиту графических элементов на листе. Совсем беда - не лает, не кусает, но и не пускает. Т.е. квадратик в нижнем правом углу ячейки схватить невозможно
не вопрос - у shapов 2 задачи - закрыть индикатор примечания (потому что не на все примечания ставятся) и информировать о сути примечания - там индекс категории, цвет категории и номер в любом случае попробовать стоить. скажите - как
но в подложке одна же картинка, а у меня (я ссылки давал, откуда shapы) - по shapу на примечание. причем как и примечания, они не создаются сразу все одномоментно
тогда почти никак. Если картинки можно сделать условно прозрачными и недоступными для нажатия-выделения, то пропускать через себя фокус мышки они не могут. по крайней мере я об этом не знаю...
могу приложить пример, чтобы было нагляднее. Опишу ситуацию полнее, чтобы можно было найти решение. Для ячейки с примечанием на месте треугольника примечания добавляется прямоугольник размером ШхВ=6х2 мм. Когда примечания находятся в соседних ячейках, то закрывают доступ к содержимому. В частности, самый больной вопрос схватить нижний правый угол, чтобы протащить по рядам. Такое ощущение, что радиус восприятия у прямоугольников перекрывает размеры ячейки по вертикали. Вот если бы его можно было уменьшить - сделать, скажем, меньше физических размеров
можно ставить прямоугольник левее, чтобы не закрывал доступ к крестику. Можно ставить условное форматирование в ячейку с примечанием. Надо смотреть пример.
кстати, пробовал смещать влево на 2 пт. Изначально у меня располагался рядом с родным треугольником. Но тогда сильно срезает данные на стандартной ячейке. Увеличение ячейки считаю не вариант, потому что не только я считать и править буду (это раз) и таблица расчета большая, хотелось бы, чтобы она максимально охватывалась взглядом (это два) Ну и вернусь к тому с чего начал. Изначально прямоугольник был смещен влево на 4 пт, но сильно закрывал содержимое ячейки.2 пт терпимо закрывает, но так же делает недоступным правый угол ячейки
Господи, ни разу за все сообщения в этой теме, оказывается, не докрутил до конца страничку Файл в формате 2003, поскольку у меня дома 13й офис. На работе 7й. В общем, поскольку не у всех 13й, потому 2003й Модуль в творческой недописанности, кнопка - чтобы знать, откуда смотреть Да, и цель - заполнить проиндексированную примечаниями область
Все-таки советую отказаться от Shapes, с ними мороки масса... Попробуйте вместо вставки Shapes делать частичную заливку ячеек, например вот так - правый верхний угол:
Код
With Selection.Interior
.Pattern = xlPatternLinearGradient
.Gradient.Degree = -20
.Gradient.ColorStops.Clear
End With
With Selection.Interior.Gradient.ColorStops.Add(0)
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.Interior.Gradient.ColorStops.Add(0.8)
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.Interior.Gradient.ColorStops.Add(0.9)
.Color = RGB(0, 220, 0)
.TintAndShade = 0
End With
With Selection.Interior.Gradient.ColorStops.Add(1)
.Color = RGB(0, 220, 0)
.TintAndShade = 0
End With
просто заливка ячеек по диапазонам используется шаблонно для выделения групп расчетов. В данном случае, появление в группе ячейки с неопределенной заливкой будет не так воспринята, а в большинстве случаев, и перезалита. Хотя в общем, идея отличная Посмотрел ночью статью, попробовал, подобрал цвета, добавил код для закрашенных ячеек, сделал четкую границу (как в статье) . Самое главное, когда начал расписывать всю работу, то оказалось, что в основном работа ведется с одной ячейкой за раз. И если контролировать имя чего-то еще, а не Shape, визуально порядковый номер можно вносить в 1ю информационную строку примечания. То предложенный вариант градиентной заливки даже лучше. В итоге, огромное спасибо. Код на праздниках исправлю, выложу
Итак, если брать только вопрос выделения примечаний по группам (альтернативного значка примечаний), то с подсказки многоуважаемого Максима Зеленского код будет следующим:
Код
Public Enum tpCommColor
cmtWhite 'As Long
cmtGreen 'As Long
cmtBlue 'As Long
cmtRed 'As Long
cmtOrange 'As Long
cmtYellow 'As Long
cmtDarkGreen 'As Long
cmtDarkBlue 'As Long
cmtDarkRed 'As Long
cmtDarkOrange 'As Long
cmtDarkYellow 'As Long
End Enum
Public Enum plCommFill
cmtForeColor 'As Long
cmtBorderColor 'As Long
cmtTextColor 'As Long
End Enum
'==================
Sub t_altCommInd()
altCommInd cmtDarkYellow 'photo
ActiveCell.Offset(1, 0).Select
altCommInd cmtDarkBlue 'price
ActiveCell.Offset(1, 0).Select
altCommInd cmtDarkGreen 'info
ActiveCell.Offset(1, 0).Select
altCommInd cmtDarkRed 'need
ActiveCell.Offset(1, 0).Select
altCommInd cmtDarkOrange 'alarm
End Sub
'==================
Sub altCommInd(cmtTypeColor As tpCommColor)
Dim oldNum As MsoRGBType
With Selection.Interior
If .Pattern = xlNone Then
oldNum = 0
Else
oldNum = .Color
End If
.Pattern = xlPatternLinearGradient
.Gradient.Degree = -12 '-20
.Gradient.ColorStops.Clear
End With
With Selection.Interior.Gradient.ColorStops.Add(0)
If oldNum <> 0 Then
.Color = oldNum
Else
.ThemeColor = xlThemeColorDark1
End If
.TintAndShade = 0
End With
With Selection.Interior.Gradient.ColorStops.Add(0.799)
If oldNum <> 0 Then
.Color = oldNum
Else
.ThemeColor = xlThemeColorDark1
End If
.TintAndShade = 0
End With
With Selection.Interior.Gradient.ColorStops.Add(0.8 )
.Color = numCommColorRGB(cmtTypeColor)
.TintAndShade = 0
End With
With Selection.Interior.Gradient.ColorStops.Add(1)
.Color = numCommColorRGB(cmtTypeColor)
.TintAndShade = 0
End With
End Sub
'==================
Sub altCommInd_Del()
Dim oldNum As MsoRGBType, tpPat As XlPattern
Dim numTheme As Long, zoneColor As ColorStop
With ActiveCell.Interior
tpPat = xlPatternSolid
Set zoneColor = .Gradient.ColorStops.Item(1)
numTheme = zoneColor.ThemeColor
If numTheme = xlThemeColorDark1 Then
oldNum = 0
Else
oldNum = zoneColor.Color
End If
.Pattern = tpPat
If oldNum = 0 Then
.ThemeColor = xlThemeColorDark1
Else
.Color = oldNum
End If
End With
End Sub
'==================
Function numCommColorRGB(ColorName As tpCommColor, Optional ColorPlace As plCommFill = cmtForeColor) As MsoRGBType
If ColorPlace = cmtForeColor Then
If ColorName = cmtGreen Then
numCommColorRGB = RGB(218, 253, 167) '.Color = 11009498
ElseIf ColorName = cmtBlue Then
numCommColorRGB = RGB(158, 234, 255) '.Color = 16771742
ElseIf ColorName = cmtRed Then
numCommColorRGB = RGB(255, 162, 161) '.Color = 10593023
ElseIf ColorName = cmtOrange Then
numCommColorRGB = RGB(250, 192, 144) '.Color = 749285
ElseIf ColorName = cmtYellow Then
numCommColorRGB = RGB(245, 253, 56) '.Color = 3735029
ElseIf ColorName = cmtDarkGreen Then
numCommColorRGB = RGB(0, 176, 80)
ElseIf ColorName = cmtDarkBlue Then
numCommColorRGB = RGB(0, 112, 192)
ElseIf ColorName = cmtDarkRed Then
numCommColorRGB = RGB(255, 0, 0)
ElseIf ColorName = cmtDarkOrange Then
numCommColorRGB = RGB(229, 110, 0)
ElseIf ColorName = cmtDarkYellow Then
numCommColorRGB = RGB(154, 150, 0)
End If
ElseIf ColorPlace = cmtBorderColor Then
If ColorName = cmtGreen Then
numCommColorRGB = RGB(41, 97, 66) '.ThemeColor = 7
ElseIf ColorName = cmtBlue Then
numCommColorRGB = RGB(30, 15, 121) '.ThemeColor = 9
ElseIf ColorName = cmtRed Then
numCommColorRGB = RGB(189, 26, 13) '.ThemeColor = 6 '.Color = -16777024
ElseIf ColorName = cmtOrange Then
numCommColorRGB = RGB(180, 86, 8 ) '.ThemeColor = 10
ElseIf ColorName = cmtYellow Then
numCommColorRGB = RGB(127, 133, 1) '.ThemeColor = 1
End If
Else
numCommColorRGB = RGB(255, 255, 255)
End If
End Function
пришлось добавить в нескольких местах пробелы, а не то 8+)=8) поменял угол наклона значка с 20 на 12 градусов. Немного необычно смотрится. Связано со следующим - в эксплуатации столкнулся, что высота строки может измениться. И треугольник из равностороннего вытягивается в сосульку. При угле в 12 градусов треугольник почти при любой высоте строки будет одной стороной равен ширине знака, высотой - высоте строки. В некоторых случаях более сильно будет восприниматься полоска с краю - тогда угол надо делать 0