» Excel VBA (часть 3)

SAS888
Спасибо, это то, что мне нужно. Двойной клик по нужной ячейке (Worksheet_BeforeDoubleClick) вызывает пользовательскую форму (UserForm), а в ней выбор команды перехода в желаемое место. Так можно обойти ограничение в Excel, связанное с отсутствием текстовых гиперссылок.

Если есть иной способ, будет интересно узнать.

Alex_B там есть гиперссылки. Можно даже на ячейку ссылаться: правый клик на ячейке - Гиперссылка - Место в документе.
з.ы. а вместо привязки к даблклику по ячейке можно просто кнопку сделать. Хотя это зависит от того, что собссно вы сделать хотите.)

Winand

Цитата:

зависит от того, что собссно вы сделать хотите

две гиперссылки (или больше) в одну ячейку (каждому слову - свою, например)

Цитата:

там есть гиперссылки

Гиперессылки есть, но не там.
Гиперссылка есть ИЗ ячейки (или из графического объекта), но нет разных гиперссылок ИЗ разных слов в одной текстовой ячейке.

Подскажите ,есть ли такой конвертер формул экселя в запросы sql и наоборот
например простейшее скулевское выражение
case when x1=1 then 'r' else 'e' end as 'так то'
тоже самое что
Если х1=1;r
ну я утрировано пишу.

Alex_B пришла идея, что можно отслеживать в каком месте ячейки сделан клик на событии SelectionChange. Не уверен, что это в принципе может помочь, но оставлю написанное тут.) Делал в 2013ом офисе, не уверен, что структура окон в других офисах такая же

Код: Private Function topix(ByVal points As Long) As Long
topix = points / 72 * 96
End Function

Sub xy_cell()
Dim pt As POINTAPI, hw As Long, hh As Long
CR = Selection.row
cc = Selection.Column

hw = 26 'Ширина хедера
hh = 20 'Высота хедера

Set wnd = ActiveWorkbook.parent.Windows(1)
lr = wnd.VisibleRange.row
lc = wnd.VisibleRange.Column
xldesk = FindWindowEx(Application.hwnd, 0, "XLDESK", vbNullString)
excel7 = FindWindowEx(xldesk, 0, "EXCEL7", vbNullString)
Set rng = Range(Cells(lr, lc), Cells(CR, cc))

GetCursorPos pt
ScreenToClient excel7, pt

cell_w = topix(Cells(CR, cc).Width)
cell_h = topix(Cells(CR, cc).Height)
cell_x = topix(rng.Width) - cell_w
cell_y = topix(rng.Height) - cell_h
Debug.Print pt.x - hw - cell_x, pt.y - hh - cell_y
End Sub

Сломал голову:
Office 2010
лист Excel->разработчик-> вставить-> Элементы ActiveX->другие элементы управления->windows Media Player

даю ему ссылку "http://translate.google.com/translate_tts?tl=en&prev=input&q=Hello"
играет, все в порядке
дяю ему ссылку на руский текст в utf-8
http://translate.google.com/translate_tts?tl=ru&q=%EF%F0%E8%E2%E5%F2
какую-то ботву говорит

если ссылку в броузере открыть - читает нормально

вот код, хотя он и не важен, ввожу в параметры в URL эту ссылку - тоже самое

Sub test()
Dim wmp As WindowsMediaPlayer
Set wmp = ThisWorkbook.Sheets(1).WindowsMediaPlayer1
wmp.URL = "http://translate.google.com/translate_tts?tl=ru&q=%EF%F0%E8%E2%E5%F2"
End Sub

гуглил, в яндексе искал - ничего не могу найти.

Добавлено:
Сломал голову:
Office 2010
лист Excel->разработчик-> вставить-> Элементы ActiveX->другие элементы управления->windows Media Player

даю ему ссылку "http://translate.google.com/translate_tts?tl=en&prev=input&q=Hello"
играет, все в порядке
дяю ему ссылку на руский текст в utf-8
http://translate.google.com/translate_tts?tl=ru&q=%EF%F0%E8%E2%E5%F2
какую-то ботву говорит

если ссылку в броузере открыть - читает нормально

вот код, хотя он и не важен, ввожу в параметры в URL эту ссылку - тоже самое

Sub test()
Dim wmp As WindowsMediaPlayer
Set wmp = ThisWorkbook.Sheets(1).WindowsMediaPlayer1
wmp.URL = "http://translate.google.com/translate_tts?tl=ru&q=%EF%F0%E8%E2%E5%F2"
End Sub

гуглил, в яндексе искал - ничего не могу найти.

kok80
Вы, если не ошибаюсь, передаёте строку в cp1251. Нормально получилось в utf-8 с указанием кодировки. Попробуйте url-encode-decode.com
url="http://translate.google.com/translate_tts?ie=UTF-8&tl=ru&q=%D0%BF%D1%80%D0%B8%D0%B2%D0%B5%D1%82"
з.ы. контрол WMP можно положить на userform, чтобы не мешался на листе.

действительно с правильной UTF8 всё работает. Но с другой стороны - какая WMP разница в какой кодировке ему дают ссылку, его дело открыть. Броузер же нормально прослушивает, хотя может броузер что-то перекодирует

Посдкажите, как написать макрос. в файле надо удалить все столбцы кроме столбца С и отображалась кнопка "удалить столбцы" жмешь и все удаляется)

Futurism удалить столбцы или только их содержимое?

Winand
их содержимое.

привязать к кнопке макрос с кодом Range("A:B,D:XFD").ClearContents()

Здравствуйте.
Подскажите пожалуйста как повесить на кнопку следующую процедуру:
Пользователь выделяет ячейки, нажимает на кнопку. К выделенным ячейкам применяется условие If (например если число в ячейке больше 1, то) и если условие выполняется, то ячейка заливается красным цветом, если нет, то жёлтым.

superpsih
Код: Sub test(): Dim r As Range, c As Range
Set r = Application.Selection: For Each c In r
If c > 0.5 Then c.Interior.ColorIndex = 3 Else c.Interior.ColorIndex = 6
Next c: End Sub

Спасибо!

подскажите. вот для примера набор данных. Взял из головы
http://rghost.ru/8Q2fhh2DB
столбец A это id
B-фио
С номер кейса
D-состояние
E номер телефона

как можно сделать чтобы отобразились те данные, где
в столбце А тип number (4)

в столбце B тип varchar(20 char)
в столбце С тип varchar(12 char)
В столбце D тип number(1)
в столбце E тип number(11)

Fsp050
Я бы забил справа вот страшную формулу ниже и "заполнил вниз" до конца данных, затем можно отфильтровать по значению ИСТИНА.
=И(
ЕЧИСЛО(A1);ДЛСТР(A1)=4;
ЕТЕКСТ(B1);ДЛСТР(B1)<=20;
ЕТЕКСТ(C1);ДЛСТР(C1)=12;
ЕЧИСЛО(D1);ДЛСТР(D1)=1;
ЕЧИСЛО(E1);ДЛСТР(E1)=11
)

Winand
не-не, тут именно макросом надо) задачка так стоит)

Fsp050 ну например вот так. ищет и выводит в консоль не подходящие по условиям строки

Код: Sub findNotGood()
rs = Selection.Row
re = Selection.Row + Selection.Rows.Count - 1
For i = re To rs Step -1
good = True
v = Cells(i, 1)
If Not (Len(v) = 4 And IsNumeric(v)) Then good = False
If Not (Len(Cells(i, 2)) <= 20) Then good = False
If Not (Len(Cells(i, 3)) = 12) Then good = False
v = Cells(i, 4)
If Not (Len(v) = 1 And IsNumeric(v)) Then good = False
v = Cells(i, 5)
If Not (Len(v) = 11 And IsNumeric(v)) Then good = False
If Not good Then
Debug.Print i, "not good"
End If
Next i
End Sub

Winand
макром запустил ,но что-то не сработало)
проверьте, плиз на этих данных
http://rghost.ru/7Tp5yPPXD

Fsp050 отнюдь. Во-первых, там нет ни одного значения в первом столбце длиной 4 знака.) Или вы под NUMBER(4) имеете в виду числа от 0 до 9999?

Winand
в этом файле, что я прислал там 104 строки))
берем А4 здесь 7,71, а намбер (4) подразумевает, что правильное то что тип числовой и имеет длину 4 знака

как бы сказать
Исходя из описанного ниже формата нужно выделить только корректные записи, т.е. записи такого вида.
Название поля    Тип (длина)    Обязательность
1    ID     number (4)     NOT NULL
2    FIO     varchar (20 char ) NOT NULL
3    Document     varchar (12 char NOT NULL
4    Type_phone number (1)     NULL
5    Phone    number (11)     NULL

Fsp050
дело в поле Document, который у меня должен был быть длиной ровно 12 символов.
Находит подходящие строки и выделяет жёлтым.

Код: Sub findGood()
Range("A:E").Interior.Pattern = xlNone
st = ActiveSheet.UsedRange.Row
For i = st To st + ActiveSheet.UsedRange.Rows.Count - 1
good = True
v = Cells(i, 1): If Not (Len(v) = 4 And IsNumeric(v)) Then good = False
If Not (Len(Cells(i, 2)) <= 20) Then good = False
If Not (Len(Cells(i, 3)) <= 12) Then good = False
v = Cells(i, 4): If Not (Len(v) = 1 And IsNumeric(v)) Then good = False
v = Cells(i, 5): If Not (Len(v) = 11 And IsNumeric(v)) Then good = False
If good Then _
Range("A" & i & ":E" & i).Interior.Color = vbYellow
Next i
End Sub

Fsp050
А что вообще такое number(4)?
Вот с этого и нужно начинать.
Обычно под этим подразумевают число в котором не более 4 знаков перед запятой и 0 после запятой.
Т.е. тебе нужно:
1) проверить IsNumeric(v.Value)
2) проверить, что v.Value целое
3) проверить, что v.Value < 10000 и v.Value > -10000

а проверки типа Len(v) вообще вырезать, в крайнем случае оставить Len(v.Text) для строк

Заранее прошу не пинать))
Товарищи, подскажите пожалуйста как сделать чтобы макрос выделял строку над той где стоит курсор.

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

Bozoman,
ActiveCell(0).Activate

Добавлено:
ptr73,
...Останавливаешь запись и видишь код макроса для вставания в конкретную ячейку, а не "на одну вверх от текущего положения".

Цитата:

ActiveCell(0).Activate

и каким же образом здесь идёт выделение строки? а каким образом хочет выделять Bozoman?

Цитата:

видишь код макроса для вставания в конкретную ячейку

нет, видишь код для выделения строки
а уж как выделить нужную строку догадаться не сложно

Bozoman,
А, ну да, строку...

Код:
ActiveSheet.Rows(ActiveCell.Row - 1).Select