Коллеги, реально ли реализовать на уровне VBA механизм управления несколькими СкроллБарами Одним Управляющим СкроллБаром? Вопрос возник из под задачи: Есть 13 Диаграмм и у каждой своя полоса прокрутки. Нужно Создать один Управляющий СкроллБар, чтобы управлять одновременно сразу всеми Диаграммами через связанные ячейки ихних индивидульных Скроллбаров. Как пример:
Коллеги, реально ли реализовать на уровне VBA механизм управления несколькими СкроллБарами Одним Управляющим СкроллБаром? Вопрос возник из под задачи: Есть 13 Диаграмм и у каждой своя полоса прокрутки. Нужно Создать один Управляющий СкроллБар, чтобы управлять одновременно сразу всеми Диаграммами через связанные ячейки ихних индивидульных Скроллбаров. Как пример:
А просто тупо сделать на всех скроллах ссылку на одну и ту же связанную ячейку не вариант? Или как в файле. Все аналогично можно и в VBA прописать - при работе с верхним скроллом все нижние к нему приравниваются, при работе с нижним - отвязываются и двигаются сами по себе.
А просто тупо сделать на всех скроллах ссылку на одну и ту же связанную ячейку не вариант? Или как в файле. Все аналогично можно и в VBA прописать - при работе с верхним скроллом все нижние к нему приравниваются, при работе с нижним - отвязываются и двигаются сами по себе._Boroda_
А просто тупо сделать на всех скроллах ссылку на одну и ту же связанную ячейку не вариант?
Полагаю, что не вариант. При работе с нижними скролами формула слетает, ломая всю "картинку" файла. Пожалуй нужно ещё раз изложить задачу. Есть 10 листов в Книге. На каждом листе, скажем, по 13 Диаграмм. Они построены каждая по своей таблице данных, имеет свой СкроллБар и именнованную Связанную с этим СкроллБаром ячейку.
Я написал макрос, который через UserForm создаёт новый лист и КОПИРУЕТ туда 1-ую диаграмму с 1-ого листа, 2-ую диаграмму с 3-его листа и т.д. в зависимости от того какие Диаграммы выбираются пользователем в форме.
В результате получается лист с диаграммами но без родных СкроллБаров. Однако на этом новом листе я создаю СкроллБар, через который хочу управлять этими Диаграммами, (а если зреть в корень, то менять значения связанных ячеек этих диаграмм на их родных листах.) Попробовал через событие листа: [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim MRange As Range Set MRange = Range("O5") If Not Intersect(Target, MRange) Is Nothing Then Range("G3") = Range("O5") Range("M3") = Range("O5") Range("S3") = Range("O5") End If End Sub
[/vba] Но Событие Change как на зло на изменение ячейки через СкроллБар не срабатывает.
А просто тупо сделать на всех скроллах ссылку на одну и ту же связанную ячейку не вариант?
Полагаю, что не вариант. При работе с нижними скролами формула слетает, ломая всю "картинку" файла. Пожалуй нужно ещё раз изложить задачу. Есть 10 листов в Книге. На каждом листе, скажем, по 13 Диаграмм. Они построены каждая по своей таблице данных, имеет свой СкроллБар и именнованную Связанную с этим СкроллБаром ячейку.
Я написал макрос, который через UserForm создаёт новый лист и КОПИРУЕТ туда 1-ую диаграмму с 1-ого листа, 2-ую диаграмму с 3-его листа и т.д. в зависимости от того какие Диаграммы выбираются пользователем в форме.
В результате получается лист с диаграммами но без родных СкроллБаров. Однако на этом новом листе я создаю СкроллБар, через который хочу управлять этими Диаграммами, (а если зреть в корень, то менять значения связанных ячеек этих диаграмм на их родных листах.) Попробовал через событие листа: [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim MRange As Range Set MRange = Range("O5") If Not Intersect(Target, MRange) Is Nothing Then Range("G3") = Range("O5") Range("M3") = Range("O5") Range("S3") = Range("O5") End If End Sub
[/vba] Но Событие Change как на зло на изменение ячейки через СкроллБар не срабатывает.Vostok
"Посылая кого-то в Google, Помните, завтра туда могут Послать Вас !"
Сообщение отредактировал Vostok - Четверг, 07.05.2015, 07:16
Option Explicit Dim rng As Range Private Sub hook() Dim obj As Object For Each obj In Me.ScrollBars.ShapeRange With obj.OLEFormat.Object Set rng = Union(IIf(rng Is Nothing, Range(.LinkedCell), rng), Range(.LinkedCell)) End With Next For Each obj In Me.OLEObjects If TypeOf obj.Object Is MSForms.ScrollBar Then Set rng = Union(IIf(rng Is Nothing, Range(obj.LinkedCell), rng), Range(obj.LinkedCell)) End If Next [A1].Formula = "=sum(" & rng.Address & ")" End Sub Private Sub Worksheet_Calculate() If rng Is Nothing Then Call hook With Application: .EnableEvents = False If .Average(rng) <> rng.Areas(1)(1, 1) Then rng.Value = IIf(.Min(rng) = .Median(rng), .Max(rng), .Min(rng)) End If .EnableEvents = True: End With End Sub
[/vba]
можно как-то так (наверно...)
[vba]
Код
Option Explicit Dim rng As Range Private Sub hook() Dim obj As Object For Each obj In Me.ScrollBars.ShapeRange With obj.OLEFormat.Object Set rng = Union(IIf(rng Is Nothing, Range(.LinkedCell), rng), Range(.LinkedCell)) End With Next For Each obj In Me.OLEObjects If TypeOf obj.Object Is MSForms.ScrollBar Then Set rng = Union(IIf(rng Is Nothing, Range(obj.LinkedCell), rng), Range(obj.LinkedCell)) End If Next [A1].Formula = "=sum(" & rng.Address & ")" End Sub Private Sub Worksheet_Calculate() If rng Is Nothing Then Call hook With Application: .EnableEvents = False If .Average(rng) <> rng.Areas(1)(1, 1) Then rng.Value = IIf(.Min(rng) = .Median(rng), .Max(rng), .Min(rng)) End If .EnableEvents = True: End With End Sub
Красиво! Для приложенного простого примерчика работает на Ура, но к моему файлу неприменимо. Переделал файл примера, к моему файлу наверное по смыслу ближе.
Красиво! Для приложенного простого примерчика работает на Ура, но к моему файлу неприменимо. Переделал файл примера, к моему файлу наверное по смыслу ближе.Vostok
при работе с верхним скроллом все нижние к нему приравниваются, при работе с нижним - отвязываются и двигаются сами по себе.
Что-то типа [vba]
Код
Private Sub Worksheet_Activate() Sheets("Лист2").Range("G11") = Sheets("Лист2").Range("G10").Value Sheets("Лист2").Range("M11") = Sheets("Лист2").Range("M10").Value Sheets("Лист2").Range("S11") = Sheets("Лист2").Range("S10").Value Sheets("Лист2").Range("G10,M10,S10").Formula = "=Лист1!$O$5" End Sub
Private Sub Worksheet_Deactivate() Sheets("Лист2").Range("G10") = Sheets("Лист2").Range("G11").Value Sheets("Лист2").Range("M10") = Sheets("Лист2").Range("M11").Value Sheets("Лист2").Range("S10") = Sheets("Лист2").Range("S11").Value End Sub
[/vba] Первые 3 строки в Activate не знаю, нужно Вам или нет сохранять старые значения?
при работе с верхним скроллом все нижние к нему приравниваются, при работе с нижним - отвязываются и двигаются сами по себе.
Что-то типа [vba]
Код
Private Sub Worksheet_Activate() Sheets("Лист2").Range("G11") = Sheets("Лист2").Range("G10").Value Sheets("Лист2").Range("M11") = Sheets("Лист2").Range("M10").Value Sheets("Лист2").Range("S11") = Sheets("Лист2").Range("S10").Value Sheets("Лист2").Range("G10,M10,S10").Formula = "=Лист1!$O$5" End Sub
Private Sub Worksheet_Deactivate() Sheets("Лист2").Range("G10") = Sheets("Лист2").Range("G11").Value Sheets("Лист2").Range("M10") = Sheets("Лист2").Range("M11").Value Sheets("Лист2").Range("S10") = Sheets("Лист2").Range("S11").Value End Sub
[/vba] Первые 3 строки в Activate не знаю, нужно Вам или нет сохранять старые значения?_Boroda_
Option Explicit Public col As Collection Public Sub hook() Dim wsh As Worksheet, rng As Range, obj As Object, tmp$(), i& Set col = New Collection With Application: .EnableEvents = False: .ScreenUpdating = False For Each wsh In Sheets Set rng = Nothing If wsh.ScrollBars.Count Then For Each obj In wsh.ScrollBars.ShapeRange With obj.OLEFormat.Object ReDim Preserve tmp(i) tmp(i) = wsh.Range(.LinkedCell).Address(, , , True) Set rng = Union(IIf(rng Is Nothing, Range(tmp(i)), rng), Range(tmp(i))) i = i + 1 End With Next End If For Each obj In wsh.OLEObjects If TypeOf obj.Object Is MSForms.ScrollBar Then ReDim Preserve tmp(i) tmp(i) = wsh.Range(obj.LinkedCell).Address(, , , True) Set rng = Union(IIf(rng Is Nothing, Range(tmp(i)), rng), Range(tmp(i))) i = i + 1 End If Next col.Add rng, wsh.Name Next With ActiveSheet Sheets().Select [A1].Activate ActiveCell.Formula = "=sum(" & Join(tmp, ",") & ")" .Select End With .EnableEvents = True: .ScreenUpdating = True: End With End Sub
[/vba]
[vba]
Код
Option Explicit Private Sub Workbook_SheetCalculate(ByVal Sh As Object) Dim rr As Range, rg As Range If Not Sh Is ActiveSheet Then Exit Sub If col Is Nothing Then Call hook With Application: .EnableEvents = False Set rg = col(Sh.Name) If .Average(rg) <> rg.Areas(1)(1, 1) Or rg.Count = 1 Then For Each rr In col Sheets(rr.Parent.Name).Range(rr.Address).Value = IIf(.Min(rg) = .Median(rg), .Max(rg), .Min(rg)) Next End If .EnableEvents = True: End With End Sub
[/vba]
чего-то я немного разошелся
[vba]
Код
Option Explicit Public col As Collection Public Sub hook() Dim wsh As Worksheet, rng As Range, obj As Object, tmp$(), i& Set col = New Collection With Application: .EnableEvents = False: .ScreenUpdating = False For Each wsh In Sheets Set rng = Nothing If wsh.ScrollBars.Count Then For Each obj In wsh.ScrollBars.ShapeRange With obj.OLEFormat.Object ReDim Preserve tmp(i) tmp(i) = wsh.Range(.LinkedCell).Address(, , , True) Set rng = Union(IIf(rng Is Nothing, Range(tmp(i)), rng), Range(tmp(i))) i = i + 1 End With Next End If For Each obj In wsh.OLEObjects If TypeOf obj.Object Is MSForms.ScrollBar Then ReDim Preserve tmp(i) tmp(i) = wsh.Range(obj.LinkedCell).Address(, , , True) Set rng = Union(IIf(rng Is Nothing, Range(tmp(i)), rng), Range(tmp(i))) i = i + 1 End If Next col.Add rng, wsh.Name Next With ActiveSheet Sheets().Select [A1].Activate ActiveCell.Formula = "=sum(" & Join(tmp, ",") & ")" .Select End With .EnableEvents = True: .ScreenUpdating = True: End With End Sub
[/vba]
[vba]
Код
Option Explicit Private Sub Workbook_SheetCalculate(ByVal Sh As Object) Dim rr As Range, rg As Range If Not Sh Is ActiveSheet Then Exit Sub If col Is Nothing Then Call hook With Application: .EnableEvents = False Set rg = col(Sh.Name) If .Average(rg) <> rg.Areas(1)(1, 1) Or rg.Count = 1 Then For Each rr In col Sheets(rr.Parent.Name).Range(rr.Address).Value = IIf(.Min(rg) = .Median(rg), .Max(rg), .Min(rg)) Next End If .EnableEvents = True: End With End Sub
Private Sub Worksheet_Activate() Sheets("Лист2").Range("G10,M10,S10").Formula = "=Лист1!$O$5" End Sub
[/vba]
Ок. Здорово. Вот с этим уже можно двигаться дальше. Можно работать с именнованными ячейками .LinkedCell: [vba]
Код
Dim rng As Object Set rng = Union([Ячейка1], [Ячейка2], [Ячейка3]) rng = "=Лист1!$O$5"
[/vba] Не получается правда вставить в Union название ячеек через массив и имя листа через переменную: [vba]
Код
Dim myArray As Variant myArray = Array("Ячейка1", "Ячейка2", "Ячейка3") Dim rng As Object Dim sheett As String sheett = "Лист1" ' Set rng = Union([Ячейка1], [Ячейка2], [Ячейка3]) Set rng = Union([Array(0)], [Array(1)], [Array(2)]) 'СИНТАКСИС ??? rng = "=Лист1!$O$5"
Private Sub Worksheet_Activate() Sheets("Лист2").Range("G10,M10,S10").Formula = "=Лист1!$O$5" End Sub
[/vba]
Ок. Здорово. Вот с этим уже можно двигаться дальше. Можно работать с именнованными ячейками .LinkedCell: [vba]
Код
Dim rng As Object Set rng = Union([Ячейка1], [Ячейка2], [Ячейка3]) rng = "=Лист1!$O$5"
[/vba] Не получается правда вставить в Union название ячеек через массив и имя листа через переменную: [vba]
Код
Dim myArray As Variant myArray = Array("Ячейка1", "Ячейка2", "Ячейка3") Dim rng As Object Dim sheett As String sheett = "Лист1" ' Set rng = Union([Ячейка1], [Ячейка2], [Ячейка3]) Set rng = Union([Array(0)], [Array(1)], [Array(2)]) 'СИНТАКСИС ??? rng = "=Лист1!$O$5"
Коллега, всё это очень Здорово и Красиво. Но я не могу понять, что мне с этим делать? Все ячейки связаны (зачем?) , да ещё и очень сложным кодом. Спасибо конечно за отзыв, но увы, как это адаптировать под мой файл - я не сообразил.
Коллега, всё это очень Здорово и Красиво. Но я не могу понять, что мне с этим делать? Все ячейки связаны (зачем?) , да ещё и очень сложным кодом. Спасибо конечно за отзыв, но увы, как это адаптировать под мой файл - я не сообразил.Vostok
"Посылая кого-то в Google, Помните, завтра туда могут Послать Вас !"
Сообщение отредактировал Vostok - Четверг, 07.05.2015, 08:41
Объединение диапазонов с разных листов? Не покатит
Вот блин. Имена то уровня Книги. И нигде об этом ни слова не написано (Я имею в виду теорию). Обидно однако. Тогда придётся тупо как-то так. По крайней мере этот вариант работает: [vba]
[/vba] А есть возможность Имя ячейки (к примеру - Ячейка2) и имя Листа (к примеру - Лист1 в выражении "=Лист1!$O$5") вставить через переменные, или тоже не прокатит? Дело в том, что всё будет в большом цикле и имена связанных ячеек и имена листов с которых будут копироваться Диаграммы я планирую "загнать" в массив. Что-то у меня проблема с синтаксисом.
Объединение диапазонов с разных листов? Не покатит
Вот блин. Имена то уровня Книги. И нигде об этом ни слова не написано (Я имею в виду теорию). Обидно однако. Тогда придётся тупо как-то так. По крайней мере этот вариант работает: [vba]
[/vba] А есть возможность Имя ячейки (к примеру - Ячейка2) и имя Листа (к примеру - Лист1 в выражении "=Лист1!$O$5") вставить через переменные, или тоже не прокатит? Дело в том, что всё будет в большом цикле и имена связанных ячеек и имена листов с которых будут копироваться Диаграммы я планирую "загнать" в массив. Что-то у меня проблема с синтаксисом.Vostok
"Посылая кого-то в Google, Помните, завтра туда могут Послать Вас !"
Сообщение отредактировал Vostok - Четверг, 07.05.2015, 13:34
Массив типа Range для меня открытие :-) Отдельный респект за информацию !!! У меня будет Массив из Имён Ячеек и Имён листов (обыкновенный массив, имена - строки), и в связи с этим последний вопрос. 1. В нижеприведённой строке кода имя - Ячейка1 подставить через переменную можно ?
Dim xBuf(1 To 7) As Variant For i = 1 To 7 xBuf(i) = "Ячейка" & i Next i Dim a(1 To 7) As Range Set a(1) = Evaluate("& xBuf(1) & ") '[Ячейка1] '??? Set a(2) = [xBuf(2)] '[Ячейка2]'??? Set a(3) = [xBuf(3)] '[Ячейка3]'??? Set a(4) = [xBuf(4)] '[Ячейка4]'??? Set a(5) = [xBuf(5)] '[Ячейка5]'??? Set a(6) = [xBuf(6)] '[Ячейка6]'??? Set a(7) = [xBuf(7)] '[Ячейка7]'???
[/vba] Какой синтаксис здесь уместен?
Массив типа Range для меня открытие :-) Отдельный респект за информацию !!! У меня будет Массив из Имён Ячеек и Имён листов (обыкновенный массив, имена - строки), и в связи с этим последний вопрос. 1. В нижеприведённой строке кода имя - Ячейка1 подставить через переменную можно ?
Dim xBuf(1 To 7) As Variant For i = 1 To 7 xBuf(i) = "Ячейка" & i Next i Dim a(1 To 7) As Range Set a(1) = Evaluate("& xBuf(1) & ") '[Ячейка1] '??? Set a(2) = [xBuf(2)] '[Ячейка2]'??? Set a(3) = [xBuf(3)] '[Ячейка3]'??? Set a(4) = [xBuf(4)] '[Ячейка4]'??? Set a(5) = [xBuf(5)] '[Ячейка5]'??? Set a(6) = [xBuf(6)] '[Ячейка6]'??? Set a(7) = [xBuf(7)] '[Ячейка7]'???