На листе есть текстовая строка: "Один Два Три Четыре Пять Шесть Семь Восемь".
Как макросом определить числовые координаты слова "Семь" - на листе? То есть непосредственной координатой - можно считать координату точки - первой буквы слова "семь" - буквы "с". Координаты (X и Y) нужно вписать в ячейки E23 и E24.
На листе есть текстовая строка: "Один Два Три Четыре Пять Шесть Семь Восемь".
Как макросом определить числовые координаты слова "Семь" - на листе? То есть непосредственной координатой - можно считать координату точки - первой буквы слова "семь" - буквы "с". Координаты (X и Y) нужно вписать в ячейки E23 и E24.odeon16
odeon16, ток костылями знаю как, ито примерно: [vba]
Код
Sub SlovCoord() Dim OL, tb As MSForms.TextBox, tbName$ Dim shp As Shape Dim X&, Y&, X0&, Y0& Dim fontName$, fontSize&, fontItalic As Boolean, fontBold As Boolean Dim r As Range, slovo$ Dim rX As Range, rY As Range 'задаём ячейки вывода координаты по X и по Y Application.ScreenUpdating = False Set r = Selection 'из выделенной ячейки X0 = r.Left - 12 'textbox делает небольшой отступ слева для текста Y0 = r.Top With r.Font fontName = .Name fontSize = .Size fontBold = .Bold fontItalic = .Italic End With Set rX = Cells(23, 5) Set rY = Cells(24, 5) tbName = "textbName" slovo = InputBox("Введите слово, координату которого ищете", _ "Слово", "семь") Set OL = ActiveSheet.OLEObjects.Add("Forms.TextBox.1") OL.Name = tbName Set tb = OL.Object Set shp = ActiveSheet.Shapes(tbName) shp.Left = X0 shp.Top = Y0 shp.Height = r.Height ' tb.Value = "1" tb.AutoSize = True tb.WordWrap = False tb.Font.Size = fontSize tb.Font.Italic = fontItalic tb.Font.Bold = fontBold tb.Font.Name = fontName tb.Activate tb.Value = Left(r.Value, InStr(1, r.Value, slovo)) ' tb.SpecialEffect = 1
X = X0 + shp.Width Y = Y0 + shp.Height / 2 shp.Delete Set tb = Nothing Set shp = Nothing rX = X rY = Y Application.ScreenUpdating = True End Sub
[/vba]
odeon16, ток костылями знаю как, ито примерно: [vba]
Код
Sub SlovCoord() Dim OL, tb As MSForms.TextBox, tbName$ Dim shp As Shape Dim X&, Y&, X0&, Y0& Dim fontName$, fontSize&, fontItalic As Boolean, fontBold As Boolean Dim r As Range, slovo$ Dim rX As Range, rY As Range 'задаём ячейки вывода координаты по X и по Y Application.ScreenUpdating = False Set r = Selection 'из выделенной ячейки X0 = r.Left - 12 'textbox делает небольшой отступ слева для текста Y0 = r.Top With r.Font fontName = .Name fontSize = .Size fontBold = .Bold fontItalic = .Italic End With Set rX = Cells(23, 5) Set rY = Cells(24, 5) tbName = "textbName" slovo = InputBox("Введите слово, координату которого ищете", _ "Слово", "семь") Set OL = ActiveSheet.OLEObjects.Add("Forms.TextBox.1") OL.Name = tbName Set tb = OL.Object Set shp = ActiveSheet.Shapes(tbName) shp.Left = X0 shp.Top = Y0 shp.Height = r.Height ' tb.Value = "1" tb.AutoSize = True tb.WordWrap = False tb.Font.Size = fontSize tb.Font.Italic = fontItalic tb.Font.Bold = fontBold tb.Font.Name = fontName tb.Activate tb.Value = Left(r.Value, InStr(1, r.Value, slovo)) ' tb.SpecialEffect = 1
X = X0 + shp.Width Y = Y0 + shp.Height / 2 shp.Delete Set tb = Nothing Set shp = Nothing rX = X rY = Y Application.ScreenUpdating = True End Sub
Жму на кнопку "Координата слова" - выдает одну координату. Жму на кнопку "Координата кружка" - выдает совершенно другую координату. Хотя по логике - координаты кружка должны - хотя бы примерно соответствовать координате слова.
Изменил местоположение нужного слова - в большую сторону. Координаты - показывают изменение в меньшую сторону. Причем меняется - даже координата Y, хотя положение строки по вертикали - я никак не меняю.
Roman777, не работает.
Жму на кнопку "Координата слова" - выдает одну координату. Жму на кнопку "Координата кружка" - выдает совершенно другую координату. Хотя по логике - координаты кружка должны - хотя бы примерно соответствовать координате слова.
Изменил местоположение нужного слова - в большую сторону. Координаты - показывают изменение в меньшую сторону. Причем меняется - даже координата Y, хотя положение строки по вертикали - я никак не меняю.odeon16
[/vba] будет некорректно искать, если какое-нибудь предшествующее слово в тексте будет "субстрокой" искомого. и да, забыл уточнить, перед нажатием на кнопку "координата слова" необходимо выделить ячейку, в котором интересующий текст.
odeon16, Файлик приложите, мб дело в поиске "нужного слова" что вы ищите и в каком тексте?. У меня работает без проблем, правда с таким [vba]
[/vba] будет некорректно искать, если какое-нибудь предшествующее слово в тексте будет "субстрокой" искомого. и да, забыл уточнить, перед нажатием на кнопку "координата слова" необходимо выделить ячейку, в котором интересующий текст.Roman777
Много чего не знаю!!!!
Сообщение отредактировал Roman777 - Вторник, 30.05.2017, 16:26
Координаты кружка - значительно расходятся с координатой слова. Этот макрос судя по всему - ищет не координаты слова, а координаты самой ячейки. Потому что - когда я - вставляю перед словом "Семь" - несколько пробелов... координаты выдаваемые макросом не меняются, хотя по логике - должна увеличится координата X.
Координаты кружка - значительно расходятся с координатой слова. Этот макрос судя по всему - ищет не координаты слова, а координаты самой ячейки. Потому что - когда я - вставляю перед словом "Семь" - несколько пробелов... координаты выдаваемые макросом не меняются, хотя по логике - должна увеличится координата X.odeon16
Сообщение отредактировал odeon16 - Вторник, 30.05.2017, 18:32
odeon16, перед нажатием кнопки "координата слова" Вы какую ячейку выделяете? Попробуйте такой:
[vba]
Код
Sub SlovCoord() Dim OL, tb As MSForms.TextBox, tbName$ Dim shp As Shape Dim X&, Y&, X0&, Y0& Dim fontName$, fontSize&, fontItalic As Boolean, fontBold As Boolean Dim r As Range, slovo$ Dim rX As Range, rY As Range 'задаём ячейки вывода координаты по X и по Y Application.ScreenUpdating = False Set r = Cells(18, 5) 'r = Selection 'из выделенной ячейки X0 = r.Left - 12 'textbox делает небольшой отступ слева для текста Y0 = r.Top With r.Font fontName = .Name fontSize = .Size fontBold = .Bold fontItalic = .Italic End With Set rX = Cells(23, 5) Set rY = Cells(24, 5) tbName = "textbName" slovo = InputBox("Введите слово, координату которого ищете", _ "Слово", "семь") Cells(1, 1).Select 'Почему-то на размер ТекстБокса влияет выделенная ячейка, поэтому закрепляем Set OL = ActiveSheet.OLEObjects.Add("Forms.TextBox.1") r.Select OL.Name = tbName Set tb = OL.Object Set shp = ActiveSheet.Shapes(tbName) shp.Placement = xlFreeFloating ' tb.Value = "1" shp.Height = r.Height ' shp.Left = X0 ' shp.Top = Y0 tb.AutoSize = True tb.WordWrap = False tb.Font.Size = fontSize tb.Font.Italic = fontItalic tb.Font.Bold = fontBold tb.Font.Name = fontName tb.Activate tb.Value = Left(r.Value, 1 + InStr(1, r.Value, " " & slovo)) shp.Left = X0 shp.Top = Y0 ' tb.SpecialEffect = 1 X = X0 + shp.Width Y = Y0 + shp.Height / 2 shp.Delete Set tb = Nothing Set shp = Nothing rX = X rY = Y Application.ScreenUpdating = True End Sub
ищет не координаты слова, а координаты самой ячейки
на самом деле нет. Специальных средств поиска координаты слова (части слова), я в ВБА не знаю, скорее всего их нет. Макрос создаёт отдельный объект (ТекстБокс), устанавливает свойства ширины этого текстбокса как autosize=true, подгоняет высоту по высоте ячейки и ставит прям на место координатное исследуемой ячейки и шрифты копирует из ячейки в текстбокс. Заполняя этот текстбокс, мы теоретически отодвигаем его правую границу примерно на столько же что и Ваш текст. Заполняя его до нужного символа (символ С от "семь"), мы потом можем померить ширину текстбоса и, зная его координаты вычисляем координаты (примерные) слова. Проблема в том, что размеры этого текстбокса по ширине не всегда одинаковые при одинаковом содержимом, и вроде бы зависят так же от размера ячейки, где он создаётся. Отсюда, в том числе, погрешности. Ну а в макрос удаляет объект.
odeon16, перед нажатием кнопки "координата слова" Вы какую ячейку выделяете? Попробуйте такой:
[vba]
Код
Sub SlovCoord() Dim OL, tb As MSForms.TextBox, tbName$ Dim shp As Shape Dim X&, Y&, X0&, Y0& Dim fontName$, fontSize&, fontItalic As Boolean, fontBold As Boolean Dim r As Range, slovo$ Dim rX As Range, rY As Range 'задаём ячейки вывода координаты по X и по Y Application.ScreenUpdating = False Set r = Cells(18, 5) 'r = Selection 'из выделенной ячейки X0 = r.Left - 12 'textbox делает небольшой отступ слева для текста Y0 = r.Top With r.Font fontName = .Name fontSize = .Size fontBold = .Bold fontItalic = .Italic End With Set rX = Cells(23, 5) Set rY = Cells(24, 5) tbName = "textbName" slovo = InputBox("Введите слово, координату которого ищете", _ "Слово", "семь") Cells(1, 1).Select 'Почему-то на размер ТекстБокса влияет выделенная ячейка, поэтому закрепляем Set OL = ActiveSheet.OLEObjects.Add("Forms.TextBox.1") r.Select OL.Name = tbName Set tb = OL.Object Set shp = ActiveSheet.Shapes(tbName) shp.Placement = xlFreeFloating ' tb.Value = "1" shp.Height = r.Height ' shp.Left = X0 ' shp.Top = Y0 tb.AutoSize = True tb.WordWrap = False tb.Font.Size = fontSize tb.Font.Italic = fontItalic tb.Font.Bold = fontBold tb.Font.Name = fontName tb.Activate tb.Value = Left(r.Value, 1 + InStr(1, r.Value, " " & slovo)) shp.Left = X0 shp.Top = Y0 ' tb.SpecialEffect = 1 X = X0 + shp.Width Y = Y0 + shp.Height / 2 shp.Delete Set tb = Nothing Set shp = Nothing rX = X rY = Y Application.ScreenUpdating = True End Sub
ищет не координаты слова, а координаты самой ячейки
на самом деле нет. Специальных средств поиска координаты слова (части слова), я в ВБА не знаю, скорее всего их нет. Макрос создаёт отдельный объект (ТекстБокс), устанавливает свойства ширины этого текстбокса как autosize=true, подгоняет высоту по высоте ячейки и ставит прям на место координатное исследуемой ячейки и шрифты копирует из ячейки в текстбокс. Заполняя этот текстбокс, мы теоретически отодвигаем его правую границу примерно на столько же что и Ваш текст. Заполняя его до нужного символа (символ С от "семь"), мы потом можем померить ширину текстбоса и, зная его координаты вычисляем координаты (примерные) слова. Проблема в том, что размеры этого текстбокса по ширине не всегда одинаковые при одинаковом содержимом, и вроде бы зависят так же от размера ячейки, где он создаётся. Отсюда, в том числе, погрешности. Ну а в макрос удаляет объект.Roman777
Выделяю ячейку с текстом как вы мне и сказали. В вашем последнем файле: Координаты слова "семь" - X=181 ,Y=223 Координаты кружка X=352 ,Y=223. (вроде бы координаты X - должны хоть немного быть похожи)
Ввел координаты слова "пять" ... Координаты слова "пять" - X=181 ,Y=223 . В общем те же самые, что и у слова "семь", хотя вроде бы слово "пять"- стоит левее. (У меня Win7, Excel 2013 64)
Специальных средств поиска координаты слова (части слова), я в ВБА не знаю, скорее всего их нет.
Я спрашивал не про специальные средства, а про нахождение координаты. Я не специалист по экселю, конечно. Но чисто теоретически вижу решение таким: Макрос ищет в ячейке с адресом E18 - первое слева - слово "семь". Затем считает количество символов которое отделяет это слово от левого края. Затем определяет координаты ячейки E18. Затем добавляет к координате X ячейки - количество символов (от слова "семь" до левой границы), умноженное на среднюю величину символа (каждый символ в ширину - примерно равен 4). Координата Y - слова равна координате Y, ячейки E18.
Выделяю ячейку с текстом как вы мне и сказали. В вашем последнем файле: Координаты слова "семь" - X=181 ,Y=223 Координаты кружка X=352 ,Y=223. (вроде бы координаты X - должны хоть немного быть похожи)
Ввел координаты слова "пять" ... Координаты слова "пять" - X=181 ,Y=223 . В общем те же самые, что и у слова "семь", хотя вроде бы слово "пять"- стоит левее. (У меня Win7, Excel 2013 64)
Специальных средств поиска координаты слова (части слова), я в ВБА не знаю, скорее всего их нет.
Я спрашивал не про специальные средства, а про нахождение координаты. Я не специалист по экселю, конечно. Но чисто теоретически вижу решение таким: Макрос ищет в ячейке с адресом E18 - первое слева - слово "семь". Затем считает количество символов которое отделяет это слово от левого края. Затем определяет координаты ячейки E18. Затем добавляет к координате X ячейки - количество символов (от слова "семь" до левой границы), умноженное на среднюю величину символа (каждый символ в ширину - примерно равен 4). Координата Y - слова равна координате Y, ячейки E18.
odeon16, Складывается впечатление, что у Вас создаваемый текстБокс пустым оказывается. Я сейчас Вам файлик сброшу, выполните у себя макрос и покажите, пожалуйста, результат в виде файлика. В предыдущем и нынешнем вариантах уже без разницы какую ячейку Вы предварительно выбирите. Макрос читает ячейку "E18". Относительно Ваших мыслей о "должном" макросе... собственно почти тоже самое и происходит. Единственное, если идти по Вами предложенному пути, нужно будет учесть размер символа для всех типов шрифтов и их размеров тоже, а это, мне кажется, довольно муторно. Куда проще использовать встроенные в эксель объекты, позволяющие автоматически учитывать форматирование текста.
odeon16, Складывается впечатление, что у Вас создаваемый текстБокс пустым оказывается. Я сейчас Вам файлик сброшу, выполните у себя макрос и покажите, пожалуйста, результат в виде файлика. В предыдущем и нынешнем вариантах уже без разницы какую ячейку Вы предварительно выбирите. Макрос читает ячейку "E18". Относительно Ваших мыслей о "должном" макросе... собственно почти тоже самое и происходит. Единственное, если идти по Вами предложенному пути, нужно будет учесть размер символа для всех типов шрифтов и их размеров тоже, а это, мне кажется, довольно муторно. Куда проще использовать встроенные в эксель объекты, позволяющие автоматически учитывать форматирование текста.Roman777
Roman777, в новом файле - происходит следующее. Выделяю ячейку E18, жму на кнопку "Координаты слова". Координаты слова "семь" - X=181 ,Y=223 При этом в ячейке J10 - появляется текст "один два три четыре пять шесть с" Если еще раз нажать на кнопку "Координаты слова" - в ячейке E18 - появляется длинный текстбокс, который загораживает исходный текст в ячейке E18. Да еще вдобавок появляется текстбокс в ячейке А1. В этот момент координаты слова "семь" - X=357 ,Y=224 , что более-менее совпадает с координатой кружка. Текстбоксы сами не удаляются, а удаляются специальной кнопкой.
Только это решение такое громоздкое, и такое неудобное - что пользоваться им очень сложно.
Единственное, если идти по Вами предложенному пути, нужно будет учесть размер символа для всех типов шрифтов и их размеров тоже
Мне не надо учитывать размер каждого конкретного символа и шрифта под него, потому что решение нужно не идеально точное, а хотя бы ПРИБЛИЗИТЕЛЬНОЕ. Просто принять ширину символа равным 4 (дальше я сам подгоню подходящий размер. Шрифтом специально буду пользоваться - только 10-ым). У меня несколько сот строк - и для каждой строки создавать по две кнопки и по два текстбокса, и еще дополнительную ячейку - не подходит.
Мне нужно только выполнить несколько операций - без создания текстбоксов. Поиск в ячейке с адресом E18 - первое слева - слово "семь". Подсчет количества символов которое отделяет это слово от левого края. Определение координаты ячейки E18. Добавка к координате X ячейки - количество символов (от слова "семь" до левой границы), умноженное на среднюю величину символа (КАЖДЫЙ символ в ширину - примерно равен 4). Координата Y - слова равна координате Y, ячейки E18.
Roman777, в новом файле - происходит следующее. Выделяю ячейку E18, жму на кнопку "Координаты слова". Координаты слова "семь" - X=181 ,Y=223 При этом в ячейке J10 - появляется текст "один два три четыре пять шесть с" Если еще раз нажать на кнопку "Координаты слова" - в ячейке E18 - появляется длинный текстбокс, который загораживает исходный текст в ячейке E18. Да еще вдобавок появляется текстбокс в ячейке А1. В этот момент координаты слова "семь" - X=357 ,Y=224 , что более-менее совпадает с координатой кружка. Текстбоксы сами не удаляются, а удаляются специальной кнопкой.
Только это решение такое громоздкое, и такое неудобное - что пользоваться им очень сложно.
Единственное, если идти по Вами предложенному пути, нужно будет учесть размер символа для всех типов шрифтов и их размеров тоже
Мне не надо учитывать размер каждого конкретного символа и шрифта под него, потому что решение нужно не идеально точное, а хотя бы ПРИБЛИЗИТЕЛЬНОЕ. Просто принять ширину символа равным 4 (дальше я сам подгоню подходящий размер. Шрифтом специально буду пользоваться - только 10-ым). У меня несколько сот строк - и для каждой строки создавать по две кнопки и по два текстбокса, и еще дополнительную ячейку - не подходит.
Мне нужно только выполнить несколько операций - без создания текстбоксов. Поиск в ячейке с адресом E18 - первое слева - слово "семь". Подсчет количества символов которое отделяет это слово от левого края. Определение координаты ячейки E18. Добавка к координате X ячейки - количество символов (от слова "семь" до левой границы), умноженное на среднюю величину символа (КАЖДЫЙ символ в ширину - примерно равен 4). Координата Y - слова равна координате Y, ячейки E18.odeon16
odeon16, Это вовсе не решение, а попытка понять, почему же у Вас работает не так как я задумывал) Пока что-то не очень понимаю, почему у Вас в 1й раз текстбокса не появляется. Возможно, нужны "танцы с бубнами"...
Мне не надо учитывать размер каждого конкретного символа и шрифта под него, потому что решение нужно не идеально точное, а хотя бы ПРИБЛИЗИТЕЛЬНОЕ. Просто принять ширину символа равным 4 (дальше я сам подгоню подходящий размер. Шрифтом специально буду пользоваться - только 10-ым). У меня несколько сот строк - и для каждой строки создавать по две кнопки и по два текстбокса, и еще дополнительную ячейку - не подходит.
в таком случае, действительно проще будет ориентироваться на ширину символа. [vba]
Код
Sub KoordSlovWidthSimb() Dim r As Range Dim slovo As String Dim SimbWidth As Single Dim X&, X0&, Y0& Dim rX As Range, rY As Range 'задаём ячейки вывода координаты по X и по Y SimbWidth = 4.2 'условная ширина одного символа Set r = Selection Set rX = Cells(23, 5) Set rY = Cells(24, 5) slovo = " " & InputBox("Введите слово, координату которого ищете", _ "Слово", "семь") X0 = r.Left Y0 = r.Top X = X0 + (InStr(1, r.Value, slovo) + 1) * SimbWidth rX = X rY = Y0 End Sub
[/vba]
odeon16, Это вовсе не решение, а попытка понять, почему же у Вас работает не так как я задумывал) Пока что-то не очень понимаю, почему у Вас в 1й раз текстбокса не появляется. Возможно, нужны "танцы с бубнами"...
Мне не надо учитывать размер каждого конкретного символа и шрифта под него, потому что решение нужно не идеально точное, а хотя бы ПРИБЛИЗИТЕЛЬНОЕ. Просто принять ширину символа равным 4 (дальше я сам подгоню подходящий размер. Шрифтом специально буду пользоваться - только 10-ым). У меня несколько сот строк - и для каждой строки создавать по две кнопки и по два текстбокса, и еще дополнительную ячейку - не подходит.
в таком случае, действительно проще будет ориентироваться на ширину символа. [vba]
Код
Sub KoordSlovWidthSimb() Dim r As Range Dim slovo As String Dim SimbWidth As Single Dim X&, X0&, Y0& Dim rX As Range, rY As Range 'задаём ячейки вывода координаты по X и по Y SimbWidth = 4.2 'условная ширина одного символа Set r = Selection Set rX = Cells(23, 5) Set rY = Cells(24, 5) slovo = " " & InputBox("Введите слово, координату которого ищете", _ "Слово", "семь") X0 = r.Left Y0 = r.Top X = X0 + (InStr(1, r.Value, slovo) + 1) * SimbWidth rX = X rY = Y0 End Sub