Всплывающее окошко при наведении мышки - Мир MS Excel

Регистрация

Напомнить пароль

= Мир MS Excel/Всплывающее окошко при наведении мышки - Мир MS Excel

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

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

Мир MS Excel » Вопросы и решения » Вопросы по Excel » Всплывающее окошко при наведении мышки (Формулы/Formulas)

Всплывающее окошко при наведении мышки

Дата: Среда, 02.08.2017, 09:00 | Сообщение № 1

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

Ранг: Новичок

Сообщений: 20

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

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

Excel 2010

Добрый день, уважаемые форумчане!
Прошу у Вас помощи, т.к сама не могу справиться с поставленной задачей.

Есть количество товаров и общая сумма.
Нужно чтобы при наведении мышки, скажем на сумму всплывало окошко со стоимостью за единицу.
Если необходимо, то можно сделать ячейку с формулой вычисления, которая в итоге будет скрытой. Но желательно без нее.
Подскажите пожалуйста, возможно ли это?

К сообщению приложен файл: 1812.xls (47.5 Kb)

Ответить

Дата: Среда, 02.08.2017, 09:29 | Сообщение № 2

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

Ранг: Участник клуба

Сообщений: 2566

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

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

Excel 2010

Добрый день.
Вариант с примечаниями
[vba]

Код

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
UsedRange.ClearComments
If Intersect(Target, Range("g12:g65")) Is Nothing Then Exit Sub
With Target
    If .Columns.Count > 1 Then Exit Sub
    If .Rows.Count > 1 Then Exit Sub
    On Error Resume Next
    Price = "Цена за шт. " & Round(.Value / .Offset(0, -1).Value, 2)
    .AddComment
    .Comment.Visible = True
    .Comment.Text Price
End With
End Sub

[/vba]

К сообщению приложен файл: 6457128.xls (64.5 Kb)

Яндекс: 410016850021169

Сообщение отредактировал sboy - Среда, 02.08.2017, 09:41

Ответить

Дата: Среда, 02.08.2017, 09:42 | Сообщение № 3

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

Ранг: Участник клуба

Сообщений: 2566

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

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

Excel 2010

Забыл про деление на 0. Исправил, файл перевложил

Яндекс: 410016850021169

Ответить

Дата: Среда, 02.08.2017, 09:42 | Сообщение № 4

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

Ранг: Новичок

Сообщений: 20

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

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

Excel 2010

sboy, спасибо огромное! Все хорошо работает. Очень, очень благодарна!

Ответить

Дата: Среда, 02.08.2017, 09:53 | Сообщение № 5

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

Ранг: Новичок

Сообщений: 20

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

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

Excel 2010

Полный рабочий вариант файла небыло возможности выложить. Когда я копирую макрос в рабочую книгу, он почему-то не работает.

Ответить

Дата: Среда, 02.08.2017, 09:56 | Сообщение № 6

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

Ранг: Участник клуба

Сообщений: 2566

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

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

Excel 2010

Ksuxa, Копируете в модуль листа? суммы в столбце G?

Яндекс: 410016850021169

Ответить

Дата: Среда, 02.08.2017, 10:04 | Сообщение № 7

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

Ранг: Новичок

Сообщений: 20

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

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

Excel 2010

Да. Но там есть и другие макросы.
вот что пишет
this command will stop the debugger

Ответить

Дата: Среда, 02.08.2017, 10:17 | Сообщение № 8

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

Ранг: Участник клуба

Сообщений: 2566

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

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

Excel 2010

К сожалению, моих знаний не хватает, чтобы определить проблему без файла с ошибкой

Яндекс: 410016850021169

Ответить

Дата: Среда, 02.08.2017, 10:28 | Сообщение № 9

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

Ранг: Новичок

Сообщений: 20

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

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

Excel 2010

ссылка удалена администрацией
Покажите код макроса, который лежит в модуле листа, куда Вы пытаетесь дописать новый макрос

Простите, но другого способа, выложить файл, кроме файлообменника не придумала.

Ответить

Дата: Среда, 02.08.2017, 10:34 | Сообщение № 10

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16675

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

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

2003; 2007; 2010; 2013 RUS

Покажите код макроса, который лежит в модуле листа, куда Вы пытаетесь дописать новый макрос

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

Дата: Среда, 02.08.2017, 10:55 | Сообщение № 11

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

Ранг: Новичок

Сообщений: 20

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

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

Excel 2010

Там два макроса. Один сворачивает пустые строки по двум диапазоном, второй сортирует в алфавитном порядке тоже по двум диапазонам.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(4)) Is Nothing Then
Dim iRow1&, iRow2&
Dim Rng1 As Range, Rng2 As Range, iKey As Range, sRng As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
iRow1 = Columns("D").Find("Канцелярські товари").Row
iRow2 = Columns("D").Find("Господарські товари").Row
Set Rng1 = Range(Cells(iRow1 + 1, 4), Cells(iRow2 - 1, 93))
Set Rng2 = Range(Cells(iRow2 + 1, 4), Cells(Cells(Rows.Count, "C").End(xlUp).Row - 1, 93))
If Not Intersect(Target, Rng1) Is Nothing Then
Set iKey = Cells(iRow1 + 1, 4)
Set sRng = Rng1
ElseIf Not Intersect(Target, Rng2) Is Nothing Then
Set iKey = Cells(iRow2 + 1, 4)
Set sRng = Rng2
End If
With Me.Sort
.SortFields.Clear
.SortFields.Add Key:=iKey, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange sRng
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
r1_ = Range("B" & Rows.Count).End(xlUp).Row
If Intersect(Target, Range("AX" & r1_)) Is Nothing Then
Range("AX" & r1_).ClearComments
Exit Sub
End If
If Target.Count > 1 Then Exit Sub
If Target.Value = " " Then Exit Sub
Range("AX" & r1_).ClearComments
Target.AddComment
Target.Comment.Visible = True
ad_ = Target.Offset(-1, -1).Address
Target.Comment.Text Text:=Лист1.Range(ad_).Value
Target.Comment.Shape.Select True
Selection.ShapeRange.AutoShapeType = msoShapeRoundedRectangularCallout
Selection.AutoSize = True
tl_ = Target.Left
tt_ = Target.Top
tw_ = Target.Width
th_ = Target.Height
Selection.ShapeRange.Left = tl_ + tw_ * 2.5
Selection.ShapeRange.Top = tt_ - th_
pw_ = Selection.ShapeRange.Width
ph_ = Selection.ShapeRange.Height
jj = Selection.ShapeRange.Adjustments.Item(1)
oo = Selection.ShapeRange.Adjustments.Item(2)
Selection.ShapeRange.Adjustments.Item(1) = -tw_ * 1.5 / pw_
Selection.ShapeRange.Adjustments.Item(2) = th_ / ph_
Target.Select
End Sub

Там два макроса. Один сворачивает пустые строки по двум диапазоном, второй сортирует в алфавитном порядке тоже по двум диапазонам.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(4)) Is Nothing Then
Dim iRow1&, iRow2&
Dim Rng1 As Range, Rng2 As Range, iKey As Range, sRng As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
iRow1 = Columns("D").Find("Канцелярські товари").Row
iRow2 = Columns("D").Find("Господарські товари").Row
Set Rng1 = Range(Cells(iRow1 + 1, 4), Cells(iRow2 - 1, 93))
Set Rng2 = Range(Cells(iRow2 + 1, 4), Cells(Cells(Rows.Count, "C").End(xlUp).Row - 1, 93))
If Not Intersect(Target, Rng1) Is Nothing Then
Set iKey = Cells(iRow1 + 1, 4)
Set sRng = Rng1
ElseIf Not Intersect(Target, Rng2) Is Nothing Then
Set iKey = Cells(iRow2 + 1, 4)
Set sRng = Rng2
End If
With Me.Sort
.SortFields.Clear
.SortFields.Add Key:=iKey, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange sRng
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
r1_ = Range("B" & Rows.Count).End(xlUp).Row
If Intersect(Target, Range("AX" & r1_)) Is Nothing Then
Range("AX" & r1_).ClearComments
Exit Sub
End If
If Target.Count > 1 Then Exit Sub
If Target.Value = " " Then Exit Sub
Range("AX" & r1_).ClearComments
Target.AddComment
Target.Comment.Visible = True
ad_ = Target.Offset(-1, -1).Address
Target.Comment.Text Text:=Лист1.Range(ad_).Value
Target.Comment.Shape.Select True
Selection.ShapeRange.AutoShapeType = msoShapeRoundedRectangularCallout
Selection.AutoSize = True
tl_ = Target.Left
tt_ = Target.Top
tw_ = Target.Width
th_ = Target.Height
Selection.ShapeRange.Left = tl_ + tw_ * 2.5
Selection.ShapeRange.Top = tt_ - th_
pw_ = Selection.ShapeRange.Width
ph_ = Selection.ShapeRange.Height
jj = Selection.ShapeRange.Adjustments.Item(1)
oo = Selection.ShapeRange.Adjustments.Item(2)
Selection.ShapeRange.Adjustments.Item(1) = -tw_ * 1.5 / pw_
Selection.ShapeRange.Adjustments.Item(2) = th_ / ph_
Target.Select
End SubKsuxa

Ответить

СообщениеТам два макроса. Один сворачивает пустые строки по двум диапазоном, второй сортирует в алфавитном порядке тоже по двум диапазонам.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(4)) Is Nothing Then
Dim iRow1&, iRow2&
Dim Rng1 As Range, Rng2 As Range, iKey As Range, sRng As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
iRow1 = Columns("D").Find("Канцелярські товари").Row
iRow2 = Columns("D").Find("Господарські товари").Row
Set Rng1 = Range(Cells(iRow1 + 1, 4), Cells(iRow2 - 1, 93))
Set Rng2 = Range(Cells(iRow2 + 1, 4), Cells(Cells(Rows.Count, "C").End(xlUp).Row - 1, 93))
If Not Intersect(Target, Rng1) Is Nothing Then
Set iKey = Cells(iRow1 + 1, 4)
Set sRng = Rng1
ElseIf Not Intersect(Target, Rng2) Is Nothing Then
Set iKey = Cells(iRow2 + 1, 4)
Set sRng = Rng2
End If
With Me.Sort
.SortFields.Clear
.SortFields.Add Key:=iKey, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange sRng
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
r1_ = Range("B" & Rows.Count).End(xlUp).Row
If Intersect(Target, Range("AX" & r1_)) Is Nothing Then
Range("AX" & r1_).ClearComments
Exit Sub
End If
If Target.Count > 1 Then Exit Sub
If Target.Value = " " Then Exit Sub
Range("AX" & r1_).ClearComments
Target.AddComment
Target.Comment.Visible = True
ad_ = Target.Offset(-1, -1).Address
Target.Comment.Text Text:=Лист1.Range(ad_).Value
Target.Comment.Shape.Select True
Selection.ShapeRange.AutoShapeType = msoShapeRoundedRectangularCallout
Selection.AutoSize = True
tl_ = Target.Left
tt_ = Target.Top
tw_ = Target.Width
th_ = Target.Height
Selection.ShapeRange.Left = tl_ + tw_ * 2.5
Selection.ShapeRange.Top = tt_ - th_
pw_ = Selection.ShapeRange.Width
ph_ = Selection.ShapeRange.Height
jj = Selection.ShapeRange.Adjustments.Item(1)
oo = Selection.ShapeRange.Adjustments.Item(2)
Selection.ShapeRange.Adjustments.Item(1) = -tw_ * 1.5 / pw_
Selection.ShapeRange.Adjustments.Item(2) = th_ / ph_
Target.Select
End Sub

Автор - Ksuxa
Дата добавления - 02.08.2017 в 10:55

Дата: Среда, 02.08.2017, 11:07 | Сообщение № 12

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16675

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

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

2003; 2007; 2010; 2013 RUS

А теги где?
И вообще-то сам лист с данными тоже неплохо бы показать

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

Дата: Среда, 02.08.2017, 11:44 | Сообщение № 13

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

Ранг: Новичок

Сообщений: 20

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

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

Excel 2010

Я бы с радостью показала, но он не могу его сюда скинуть, не помещается размером.
Как этом можно сделать?

Ответить

Дата: Среда, 02.08.2017, 12:23 | Сообщение № 14

Группа: Модераторы

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

Сообщений: 2198

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

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

Excel 2010, 2016

Ksuxa, оформите код в своем предыдущем сообщении. (Кнопка # в режиме правки поста)

Цитата Ksuxa, 02.08.2017 в 11:44, в сообщении № 13 ()

не помещается размером

Оставьте только нужный лист. Все лишние модули/макросы удалите. Оставьте несколько строк на листе для примера. Все данные не нужны, главное - структура.
Можно еще сохранить в xlsb и/или заархивировать.

ЯД: 410013299366744 WM: R193491431804

Ответить

Дата: Среда, 02.08.2017, 13:38 | Сообщение № 15

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

Ранг: Новичок

Сообщений: 20

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

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

Excel 2010

Manyasha, спасибо большое.
Вроде сжала, удалив все что можно.

Ответить

Дата: Среда, 02.08.2017, 13:40 | Сообщение № 16

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

Ранг: Новичок

Сообщений: 20

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

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

Excel 2010

Вот. Надеюсь, на этот раз у меня все получилось.

К сообщению приложен файл: 1812.222____-__.rar (88.9 Kb)

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по Excel » Всплывающее окошко при наведении мышки (Формулы/Formulas)

Страница 1 из 1
1

© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!