PDA

Показать полную графическую версию : как пакетно назначить имена для клеток excel?


Страниц : 1 [2] 3

Iska
25-01-2012, 17:28
Pozia, пробуйте:
Option Explicit

Sub CopyFromExcel()
Dim objExcel As Excel.Application
Dim strAddress As String
Dim strNewName As String

Dim i As Long

Set objExcel = GetObject(, "Excel.Application")

With objExcel.Selection
If .Worksheet.Type = Excel.xlWorksheet Then
i = .Worksheet.Names.Count + 1

Do
strNewName = "_" & CStr(i)

If Not NameExists(.Worksheet, strNewName) Then
Exit Do
Else
i = i + 1
End If
Loop

If Not RangeHasName(objExcel.Selection) Then
.Worksheet.Names.Add strNewName, "=" & .Address(, , Excel.xlR1C1, True)
End If

.Copy

Selection.PasteSpecial , True, , , wdPasteRTF

.Application.CutCopyMode = False
End If
End With

Set objExcel = Nothing
End Sub

Function NameExists(objWorksheet As Excel.Worksheet, strName As String) As Boolean
On Error Resume Next

NameExists = Len(objWorksheet.Names(strName).Name) <> 0
End Function

Function RangeHasName(objRange As Excel.Range) As Boolean
On Error Resume Next

RangeHasName = Len(objRange.Name.Name) <> 0
End Function



… при его наличие у клетки »
Будет работать с любыми диапазонами (не только состоящими из одной клетки).

Pozia
25-01-2012, 22:39
Будет работать с любыми диапазонами (не только состоящими из одной клетки). »
работает. только вот если диапазон выбираю то имена не присваиваются клеткам при вставке. Это можно поправить?

Iska
26-01-2012, 01:36
Pozia, у меня присваивается. Описывайте подробно пример, а я попробую воспроизвести у себя.

Pozia
26-01-2012, 07:48
Iska, разобрался, присваивает. Просто думал что каждой ячейке в выбранном диапазоне будет присвоено имя, что предпочтительнее для меня. Так можно сделать?

Iska
26-01-2012, 16:19
…что каждой ячейке в выбранном диапазоне будет присвоено имя, что предпочтительнее для меня. Так можно сделать? »
А смысл?

Pozia
26-01-2012, 18:12
А смысл? »
для меня есть:
1. Решается вопрос, который звучит в шапке изначально. Это позволит в дальнейшем работать быстрее без скрипта там где его нет.
2. Постоянно сделав одну связь на какую то клетку, я затем в ворде просто ее копирую в другие нужные места, и связи вешаются. Если я скопирую диапазон ячеек с одним общим именем, то потом из него я не смогу копировать нужные мне ячейки в другие места документа ворд, связь повесится не верно.

Поэтому, если это возможно сделать, буду признателен. В любом случае, еще раз огромное спасибо.

Iska, правильно ли я исправил кусок кода для более наглядности:
Do
strNewName = "i" & CStr(i) & "i"
If Not NameExists(.Worksheet, strNewName) Then

Iska
26-01-2012, 19:34
1. Решается вопрос, который звучит в шапке изначально. Это позволит в дальнейшем работать быстрее без скрипта там где его нет. »
Вставьте в проект рабочей книги и выполните:
Option Explicit

Sub SetNames()
Dim objWorksheet As Worksheet
Dim objCell As Range
Dim i As Long

Set objWorksheet = Selection.Worksheet

If objWorksheet.Type = xlWorksheet Then
i = 1

For Each objCell In Selection
objWorksheet.Names.Add "_" & CStr(i), "=" & objCell.Address(, , xlR1C1, True)

i = i + 1
Next
End If

Set objWorksheet = Nothing
End Sub

Решите вопрос, который звучит в шапке изначально.

Если я скопирую диапазон ячеек с одним общим именем, то потом из него я не смогу копировать нужные мне ячейки в другие места документа ворд, связь повесится не верно. »
Данное утверждение неверно. Сможете.

Iska, правильно ли я исправил кусок кода для более наглядности: »
Вы получите имена вида: «i1i», «i2i», «i3i» и т.д.

Pozia
26-01-2012, 21:25
Решите вопрос, который звучит в шапке изначально. »
скрипт хитрый оказался ). Он забирает имена у клеток ранее названных. То есть если уже есть имена _1, _2, _3... и я выбираю другой диапазон задать имена, то он стирает имена на прежних клетках, и дает их новым клеткам. Можно ли это исправить?

Pozia
26-01-2012, 22:25
Iska, начал активно пользоваться скриптом и заметил, что часто вылетает ошибка как скрине. Отчего?

Iska
27-01-2012, 03:26
Он забирает имена у клеток ранее названных. »
Он тупо назначает имена, начиная с «_1», на адреса ячеек.

Можно ли это исправить? »
Исправить-то можно. Я ориентировался на:
вопрос, который звучит в шапке изначально. нужно определенному диапазону клеток размером 50 столбцов на 2000 строк присвоить произвольные имена. »
»
Я рассчитывал именно на то, что сие будет однократным действием.

Я понимаю, Вы никак не хотите манипулировать целыми диапазонами, а в обязательном порядке давать имена исключительно отдельным ячейкам (хотя я не вижу в этом требовании никакой необходимости). Впрочем, дело Ваше, пусть будет так, пробуйте:
Option Explicit

Sub CopyFromExcel()
Dim objExcel As Excel.Application
Dim objWorksheet As Excel.Worksheet
Dim objCell As Excel.Range

Dim strNewName As String
Dim i As Long


Set objExcel = GetObject(, "Excel.Application")
Set objWorksheet = objExcel.Selection.Worksheet

If objWorksheet.Type = Excel.xlWorksheet Then
i = objWorksheet.Names.Count

For Each objCell In objExcel.Selection
If Not RangeHasName(objCell) Then
Do
strNewName = "_" & CStr(i)

i = i + 1

If Not NameExists(objWorksheet, strNewName) Then
Exit Do
End If
Loop

objWorksheet.Names.Add strNewName, "=" & objCell.Address(, , Excel.xlR1C1, True)
End If
Next

objExcel.Selection.Copy

Selection.PasteSpecial , True, , , wdPasteRTF

objExcel.CutCopyMode = False
End If

Set objWorksheet = Nothing
Set objExcel = Nothing
End Sub

Function NameExists(objWorksheet As Excel.Worksheet, strName As String) As Boolean
On Error Resume Next

NameExists = Len(objWorksheet.Names(strName).Name) <> 0
End Function

Function RangeHasName(objRange As Excel.Range) As Boolean
On Error Resume Next

RangeHasName = Len(objRange.Name.Name) <> 0
End Function


Iska, начал активно пользоваться скриптом и заметил, что часто вылетает ошибка как скрине. Отчего? »
Опишите условия, при которых сие происходит.

Pozia
27-01-2012, 13:45
Я рассчитывал именно на то, что сие будет однократным действием. »
не. ну смотрите. Сделаю я один раз. А эксель мой еще не финишный. Все время модифицирую, и вот попробую задать новые имена и он мне как наворотит, что я фик разгребусь :) .
хотя я не вижу в этом требовании никакой необходимости »
необходимость лишь в моей специфики рабочего файла эксель, не более.
Опишите условия, при которых сие происходит. »
видимо сам виноват. тестировал какие то скрипты скачанные из нета, и в результате офис навернулся. Удалить смог только какой то спец утилитой. Зато теперь поставить не могу. Сменю винду, опробую приведенный вами скрипт. Спасибо.

Iska
27-01-2012, 16:36
Сменю винду, опробую приведенный вами скрипт. »
Сочувствую. Ждём-с.

Pozia
29-01-2012, 21:36
Iska, По поводу глюков в работе скрипта - все Ок после смены винды.
пробуйте: »
то же все классно.
Хотелось бы еще попросить Вас (простите за наглость) подкорректировать скрипт из вашего поста 27, чтоб он имена не удалял у ранее названных клеток. Простое присвоение имен клеткам как я сейчас понимаю мне тоже нужно. У меня есть еще связь между моим главным расчетным файлом эксель и файлами эксель "посредниками" между расчетным файлом эксель и SolidWorks, где тоже нужна твердая связь. И вот здесь пакетное именование клеток очень было бы кстати, чтоб потом просто вешать связи между файлами эксель.

PS Не подскажете ли, как в ворд на скрипт задать горячую клавишу. В эксель это без проблем, в ворд приходится хитрить - включать запись макроса, дам задавать сочетание клавиш, а потом под записанный макрос подсовывать свой.

Iska
03-02-2012, 15:35
Хотелось бы еще попросить Вас подкорректировать скрипт из вашего поста 27, чтоб он имена не удалял у ранее названных клеток. »
Пробуйте (код для модуля рабочей книги):
Option Explicit

Sub SetNames()
Dim objWorksheet As Worksheet
Dim objCell As Range

Dim strNewName As String
Dim i As Long


Set objWorksheet = Selection.Worksheet

If objWorksheet.Type = xlWorksheet Then
i = objWorksheet.Names.Count

For Each objCell In Selection
If Not RangeHasName(objCell) Then
Do
strNewName = "_" & CStr(i)

i = i + 1

If Not NameExists(objWorksheet, strNewName) Then
Exit Do
End If
Loop

objWorksheet.Names.Add strNewName, "=" & objCell.Address(, , xlR1C1, True)
End If
Next
End If

Set objWorksheet = Nothing
End Sub

Function NameExists(objWorksheet As Excel.Worksheet, strName As String) As Boolean
On Error Resume Next

NameExists = Len(objWorksheet.Names(strName).Name) <> 0
End Function

Function RangeHasName(objRange As Excel.Range) As Boolean
On Error Resume Next

RangeHasName = Len(objRange.Name.Name) <> 0
End Function


PS Не подскажете ли, как в ворд на скрипт задать горячую клавишу. »
Не подскажу, по той простой причине, что у Вас Office 2010, а у меня Office 2003. Но можете попробовать самостоятельно согласно статье: Настройка сочетаний клавиш - Word - Office.com (http://office.microsoft.com/ru-ru/word-help/HA010370106.aspx), выбрав в поле «Категории» категорию «Макросы», а в поле «Макросы» — Ваш макрос.

в ворд приходится хитрить - включать запись макроса, дам задавать сочетание клавиш, а потом под записанный макрос подсовывать свой. »
Сие излишне.

Pozia
03-02-2012, 21:58
Iska, спасибо, все отлично работает. повесил за эти дни около 3000 связей на имена клеток, красота.... )

Iska
04-02-2012, 10:28
Рад стараться :)! Тем паче, что и я кое-что узнал для себя нового:
Если из эксель скопировать клетку и вставить ее через специальную вставку в ворд - получится связь. Изменив значение клетки в эксель - меняется значение в ворд. Так вот если клетку в эксель куда то перенести - связь теряется. Если клетке эксель предварительно дать имя, и затем сделать связь, то так связь ворд эксель не потеряется, так как ворд будет ссылаться не на координату а на имя клетки, которое является уникальным для листа. »

Pozia
01-03-2012, 23:58
Iska, очень нужна ваша неотложная помощь. Имеется большой файл экселя. Навесил кучу связей вашим скриптом. И ща заметил, что на один из листов экселя связи ворда ссылаются не на имена ячеек, а на координаты их. Почему то скрипт упорно не делает связи на имена ячеек именно на одном листе. Прикрепляю этот лист. Помогите пожалуйста разобраться.

Iska, методом тыка установил, что виной является буква "C" первая в названии листа. Почему так?

Iska
02-03-2012, 02:19
Iska, методом тыка установил, что виной является буква "C" первая в названии листа. Почему так? »
Не подтверждаю. Как Вы сделали такой вывод?

Прикрепляю этот лист. »
Мне сложно что-либо сказать по одному листу.

Pozia
02-03-2012, 09:16
Iska, это косяк не скрипта, а как минимум офиса 2010. создал только что новый документ, добавил к имени любого листа английскую букву С, задал имя для любой ячейки на этом листе и связь в ворд повесилась на координату, а не на имя. убираю букву С с названия, и связь вешается успешно

Iska
02-03-2012, 10:45
Pozia, воспроизводится ли сие поведение «вручную»?




© OSzone.net 2001-2012