Excel перебирая коллекцию примечаний на листе получать адрес

Старая форма входа

Страница 1 из 1 1
Модератор форума: _Boroda_, китин

Мир MS Excel » Вопросы и решения » Excel и другие приложения » 1С » Excel перебирая коллекцию примечаний на листе получать адрес (Word)

Gerasimovaol

Дата: Понедельник, 12.08.2013, 12:48 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 2

Репутация: 0 ±

Замечаний: 0% ±

Добрый день!

Из 1С 7.7 обращаемся к Excel.
Есть диапазон ячеек, где одни заполнены значениями, другие нет. В отдельных
ячейках (не во всех) есть примечания.[b]
Перебираем коллекцию примечаний на конкретном листе.
Как, получив по номеру примечание в EXCEL, получить значение ячейки.???

Код в 1С 7.7
[vba]

Код

//Инициализация базовых объектов Excel.Начало
xlApp=CreateObject("Excel.Application");
xlBook=xlApp.Workbooks.Open(ИмяФайлаВосстановить);

СпЗнЛисты=СоздатьОбъект("СписокЗначений");
Для СчетчикЛистов=1 По xlBook.Worksheets.Count() Цикл
СпЗнЛисты.ДобавитьЗначение(СчетчикЛистов,xlBook.Worksheets(СчетчикЛистов).Name);
КонецЦикла;//Для СчетчикЛистов=1 По xlBook.Worksheets.Count() Цикл
НомерЛиста=0;
СпЗнЛисты.ВыбратьЗначение(НомерЛиста,"Выбор листа книги.",,,0);
Если НомерЛиста=0 Тогда
xlBook.Close();
xlApp.Quit();
КонецЕсли;//Если НомерЛиста=0 Тогда
xlSheet=xlBook.Worksheets(НомерЛиста);
Кол = xlSheet.Comments.Count;
ВсегоКол = Кол;
Для ш=1 по Кол Цикл
Стр = xlSheet.Comments(ш).Text();
сообщить(Стр);
КонецЦикла;
xlBook.Close();
xlApp.Quit();

[/vba]

Заранее спасибо!

К сообщению приложен файл: .3-2.rar (38.0 Kb)

Сообщение отредактировал Gerasimovaol - Понедельник, 12.08.2013, 12:57

Ответить

SkyPro

Дата: Понедельник, 12.08.2013, 13:46 | Сообщение № 2

Группа: Друзья

Ранг: Старожил

Сообщений: 1206

Репутация: 255 ±

Замечаний: 0% ±

2010

Вот такой макрос посмотрите.
Предварительно добавте лист "comments"

[vba]

Код

Sub comm()
On Error Resume Next
Dim rCell As Range
For Each rCell In ActiveSheet.UsedRange
If Not rCell.Comment Is Nothing Then
Sheets("comments").[a65536].End(xlUp)(2).Formula = rCell.Value
End If
Next
End Sub

[/vba]