Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 След.
Гугл диск снимает атрибут "только для чтения"
 
Добрый вечер. Возник вопрос у моих заказчиков. У них компания занимается розничными продажами на дому у клиентов. Для этого они создали рабочий документ и выложили его на яндекс диск, для того чтобы сотрудники могли пользоваться обновленными документами. Хотят сделать так чтобы никто не мог случайно сохранить в исходнике данные. Я обычно пользовался при подобных ситуациях атрибутом только для чтения. Но при обновлении файла данный атрибут снимается на тех компьютерах что его скачали. Можно ли макросом или еще как либо решить данную проблему?
Решить задачу по начертательной геометрии: 3D точки в 2D
 
Добрый вечер.

Задача следующая . Имеется массив  точек образующих плоскость. Допустим их 3штуки  (-700;200;300),(-600;1400;-700)(1500;1000;50)
Нужно вычислить координаты в 2D  в случае если мы смотрим перпендикулярно на плоскость Либо с одной либо с другой стороны. Нужно написать процедуру на VBA.


Решение в данном конкретном случае
(-1584;729)(538;1520)(639;-41) все числа округлены Ответ брал в CAD Solidworks.
Простая функция на vba проблемы с написанием
 
Добрый  вечер. Простая задачка школьного курса. Туплю , торможу, никак не получается описать функцией. Проблемы с математикой. Забыл как правильно упрощать выражения.
Мой набросок ...уже 2 часа туплю .. ничего не сходится...
Код
Sub координаты_пересечения()
coord = координаты_проекции_точки(-6, 10, 4, -5, -12, 7)
End Sub

Function координаты_проекции_точки(x, y, x1, x2, y1, y2)
'''''''''''''классическая прямая вида  a*x+b*y+c=0
'a = y1 - y2
'b = x2 - x1
'c = x1 * y2 - x2 * y1
'''''''''''''''''''''''''''' -b*x-a*y+d=0 'перпендикулярная функция
...
координаты_проекции_точки = xp & yp
End Function
Пример решения из интернета методикой школьного курса.
Скрытый текст

прошу помочь с написанием.
min площадь прямоугольника внутри которого многоугольник
 
Здравствуйте. Не могу найти алгоритм. Точнее могу но сомневаюсь в правильности его.

Исходные данные:
фигура на плоскости -выпуклый многоугольник .(Если невыпуклый, то он легко преобразовывается в выпуклый нехитрым алгоритмом.). Данные в виде последовательных координат. (2 массива x(),y())
Нужно найти координаты прямоугольника-контейнера, который имеет минимальную площадь для многоугольника.
Сам я думаю что алгоритм следующий:
1.Цикл начнем с первого отрезока x(i) y(i)-x(i+1),y(i+1)
   2 Вторым циклом J перебираем точки начиная с 3 x(j),y(j)
      и формулой точка перпендикуляр к линии находим мах точку (эдакий штангенциркуль)
       длина будет первой стороной a
       3.Вычисляем все точки по левую и по правую сторону перпендикуляра формулой  d = (x0 - x1) * (y2 - y1) - (y0 - y1) * (x2 - x1)
          если D>0 то первая сторона,
          если D<0 то вторая сторона
           для D<> 0 находится max значение длины
          если D=0 то длина =0
         складываем max(D>0) с max(D<0)=b вторая сторона
         4  stemp=a*b
        5 заканчиваем J
6 Если s<stemp то s=stemp
7 заканчиваем i

Картинка не правильно составлена но суть отражает (там где невыпуклость будем считать что вершины ее образующие удалены из цепочки ...дуга и острый угол)

Исходя из темы у меня  один вопрос , существует ли решение по поиску min S, при котором ни одна сторона контейнера не образовывает коллинеарность с любой из сторон многоугольника?
Тот же вопрос, но по другому: Cуществует ли такая фигура при которой контейнер может не использовать коллинеарность с данной фигурой.
Если нет, то алгоритм верен.
Изменено: Sla_0412 - 19 Июн 2017 18:05:12
Как лучше оптимизировать метод поиска в массиве данных.
 
Здравствуйте. Выкладываю файл. Нужны советы по оптимизации скорости работы макроса. У меня есть подозрение что алгоритм написан неверно что плохо сказывается на скорости работы.
Основная претензия к этому участку кода
Код
For i = LBound(f) To UBound(f)
    For j = 1 To rr
        x = InStr(x + 1, f(i), "/")
        
    Next j
    If x <> 0 Then
    f(i) = Mid(f(i), 1, x - 1)
    End If
    x = 0
    
    If k = f(i) Then
    n = n + 1
    ReDim Preserve arr(n)
    arr(n) = tb.Cells(i, 13 + rr)

    End If
Next i
Програмное копирование модуля открытой надстройки в новую книгу
 
Здравствуйте.
Нашел способ скопировать стандартный модуль из книги в новую книгу. Код взял с сайта http://www.excel-vba.ru/
Возникла потребность скопировать код из моей надстройки "Моя_надстройка.xlam" во вновь созданную книгу программно.
Код
Sub Copy_Module()
    Dim objVBProjFrom As Object, objVBProjTo As Object, objVBComp As Object
    Dim sModuleName As String, sFullName As String
    'расширение стандартного модуля
    Const sExt As String = ".bas"
 
    'имя модуля для копирования
    sModuleName = "prefkpChan"
    On Error Resume Next
    'проект книги, из которой копируем модуль
    Set objVBProjFrom = ThisWorkbook.VBProject
    'необходимый компонент
    Set objVBComp = objVBProjFrom.VBComponents(sModuleName)
    'если указанного модуля не существует
    If objVBComp Is Nothing Then
        MsgBox "Модуль с именем '" & sModuleName & "' отсутствует в книге.", vbCritical, "Error"
        Exit Sub
    End If
    'проект книги для добавления модуля
    Set objVBProjTo = ActiveWorkbook.VBProject
    'полный путь для экспорта/импорта модуля. К папке должен быть доступ на запись/чтение
    sFullName = "C:\" & sModuleName & sExt
    objVBComp.Export Filename:=sFullName
    objVBProjTo.VBComponents.Import Filename:=sFullName
    'удаляем временный файл для импорта
    Kill sFullName
End Sub

Как обратиться к надстройке правильно?
Меня смущает строка
Код
 'проект книги, из которой копируем модуль
    Set objVBProjFrom = ThisWorkbook.VBProject
Нужно создать функцию интерполяции таблицы x1,x2,y1,y2, со значениями
 
Добрый вечер. Приложил файлы дабы словами не расписывать, что надо получить. Тема для меня новая. Поэтому не пойму с какого угла к ней подходить. Желательно задачу решить с помощью vba. Табличка в файле прилагается как проверочная.
не совпадает zorder в цикле
 
Здравствуйте. Давно мучаюсь с shapes. До сих пор для меня трудности вызывает проблема к ним обращаться. Самая беда когда есть одноименные фигуры.
Вопрос по циклу
Код
Sub test()
    For Each p In Sheets("Лист1").Shapes
          nnn = ActiveSheet.Shapes.Range(p.Name).ZOrderPosition
          nn = p.ZOrderPosition 'почему номера не совпадают?
    
    If nnn <> nn Then
    Debug.Print p.Name
    End If
    Next p
End Sub

Почему не совпадают номера?
И как например  сделать что либо(выделить,удалить....)  с фигурой zv1, находящейся в группе и наоборот? Как к ним обращаться правильно?
Определить функцию по значениям двух столбцов таблицы
 
Здравствуйте. Друг задал мне задачку. Я думал что как то легко она должна решаться. В итоге не пойму с какого конца подойти. Нужно заполнить ряд значений в колонках таблицы. С виду функция напоминает гиперболу. Мне аж стыдно сталою. Все что проходили в школе забыл напрочь. Дайте хотя бы направление. Может на форум математиков надо обращаться?
Worksheet_Change для картинок и фигур
 
Доброй ночи всем форумчанам. Собственно в названии темы вопрос: как  реализовать события  на изменения листа, чтобы вместо target as range было target as shape.
Т.е. необходима реакция на изменения картинок их удаление, перемещение и тд. Возможно ли это? Вообще цель у меня конкретная. Запретить изменять фигуры и картинки, но так чтобы можно было их выделять.
Странное поведение сгруппированных Shapes при изменении масштаба листа
 
Добрый вечер форумчанам.
Не раз находил ответы на сложные вопросы по VBA. Надеюсь получить помощь и сейчас.
Проблема вот какая.
На листе сгруппированы Shapes "линия 1" ,"линия 2," "линия3". в группу "линии".
При масштабе листа 100% Получаю ожидаемый результат при использовании кода: Линия2 становится равной 100 точкам.
Код
Sub линии()
ActiveSheet.Shapes.Range("линия2").Width = 100
End Sub

Но как только масштаб листа делаю не = 100%, происходит необъяснимое. Вся группа начинает уменьшаться по высоте при каждом срабатывании макроса .
Группа линий выглядит как на скриншоте:
Что происходит не пойму.
Эксель 2010
запись диапазонов в 2 мерный массив построчно
 
Добрый день.
Возникла небходимость в цикле производить запись range(cells(i,1),cells(i,20), в 2 мерный массив arr(n,20)
Можно ли как либо обойтись без цикла FOR J ? Чтобы не записывать по как   arr(n,J)=rg.cells(i,J) дополнительным циклом.
Пример
Код
for i=1 to rg.rows.count
if .....
n=n+1
ReDim Preserve ax(n, 20)
'тут хочется без цикла что то похожее на
[I]?диапазон[/I] ?( arr(n,1) ,arr(n,20)) = range rg(cells(i,1),cells(i,20)
Расчет расстояния регион1-регион2 РФ
 
Здравствуйте уважаемые форумчане. Предстоит решить данную задачку.
Исходные данные. Клиент находящийся где либо в РФ. Пункт отправления город x. Необходимо рассчитать стоимость доставки товара до клиента.
Вижу 2 пути данной задачи.
1) При подключенном интернет соединении:
Клиент набирает свой город , запрос в эксель отправляется на интернет сервис. Далее возвращается в виде  расстояния
Хуже , клиент сам определяет расстояние до собственного адреса

2) При   отсутствии интернет соединения:
создание справочника. (не хочется)

Пока задачка в стадии задумки. Прошу совета в каком направлении начинать разработку идеи.
считывание данных из combobox в массив
 
Добрый день всем форумчанам. Возникла такая потребность, как считывание массива данных из combobox.
CBsystem.List = arr() только наоборот.
Можно так или нет?
Изменено: Sla_0412 - 10 Мар 2017 12:38:56
UserPicture метод. вставка картинки с листа в фигуру листа
 
Добрый вечер. Такая проблема возникла.
Не получается залить текстурой фигуру на листе
в ячейке а1 лежит картинка
Код
Sub Макрос1()
 ActiveSheet.Shapes.Range(Array("картинка")).Fill.UserPicture Cells(1, 1)
End Sub
Если вместо Cells(1, 1) вставить путь, ActiveSheet.Shapes.Range(Array("картинка")).Fill.UserPicture "C:\картинка.jpg"
то все срабатывает.
Прошу помощи.
Application.EnableEvents для userform
 
Здравствуйте уважаемые форумчане. Уже неделю мучаюсь с userform. Ситуация чем дальше, тем страшнее напоминает. Там присутствует куча зависимых combobox которые заставляют переключать элементы управления и зачастую с ошибками. Если бы меню делал на листе в ячейках, ситуацию спасла бы Application.EnableEvents. Тут похоже такой команды нет. Прошу вашего совета, как поступить в подобной ситуации.
Как запретить использование файлов в libreoffice и прочих офисов
 
Здравствуйте. Установил libreoffice. Открыл файл своего проекта "проект.xlsm" в libreoffice. Обнаружил что все  листы , которые были скрыты и запаролены открыты любому желающему. Ситуация , когда даже  не требуется скачивать какие либо взломщики с сети. Данный факт огорчает. Можно ли файл проекта привязать только к Эксель?  
отладка кода vba , неожиданно закидывает в vba функцию без видимых причин
 
Есть пользовательская функция для моих расчетов. На листах эксель эта функция производит некоторые расчеты. Вот ее код:
Код
Function zapoln(table As Range, num_st As Integer, num_vhoda As Range, usmin As Integer, usmax As Integer)
Application.Volatile
Dim ax()
   
Set arr = table

Min = usmin
Max = usmax
s = num_st
With table.Parent
   h = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
 'количество элементов массива

For i = 1 To h
    If arr(i, s) > Min And arr(i, s) < Max Then
         n = n + 1
        ReDim Preserve ax(n)  ' Preserve переопределение с сохр всех значений
        ax(n) = arr(i, 1)
    End If
Next i
arr = ax

isk = num_vhoda.Row
On Error GoTo Err_SomeName
   zapoln = arr(isk)
Exit_SomeName:
     Exit Function
Err_SomeName:
    zapoln = 0
Resume Exit_SomeName

End Function
При запуске и отладке кода иных процедур пошагово, неожиданно происходит "влет" в эту функцию. Так происходит пока не удалишь с листа все формулы с этой функцией. Не пойму как ее правильно отладить и почему так происходит.
как изменить размер именованного диапазона
 
Здравствуйте. Пробую изменить размер именованного диапазона и не пойму как это лучше сделать
Код
Sub Макрос()
Set r = Range("LOG")
f = r.Columns.Count
Sheets("формы").ListObjects("LOG").Resize Range(r.Cells(0, 1), r.Cells(1, f))
End Sub
Код составил с помощью макрорекрдера
Cобственно не нравится  :
Sheets("формы").ListObjects("LOG"). или ActiveSheet.ListObjects("LOG")
из-за того, что требуется  Sheets("формы"). Зачем именованному диапазону данное уточнение, на то он и именованный что эксель понимает его разположение где либо.
Не понятно почему нельзя
r.Resize Range(r.Cells(0, 1), r.Cells(1, f)).
Короче задача состоит в уменьшении таблички по строкам до минимума. и как это сделать правильно я не пойму.
какой правильный синтаксис у формулы INDIRECT в vba совместно с переменной
 
Добрый день.
Уже час торможу над синтаксисом кода с применением переменной.
вот в таком виде все работает:
Код
Sub Макрос(byref i)

    With Cells(i, 1).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=INDIRECT(""буфер1"")"
    End With
End Sub

Но в существует множество именованных диапазонов буфер1, буфер2....,созданных в другой процедуре.

проблема с формулой: Formula1:="=INDIRECT(""буфер1"")", где необходимо заменить 1 на переменную i.

Пробовал : Formula1:="=INDIRECT(""буфер"& i &")". получается ошибка

На всякий случай прикладываю файл с примером

запись массива arr() в формулу проверки данных ячейки
 
Добрый день.
Никак не получается записать в проверку данных ячейки массив arr()

Range("список").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="1;2"

вместо "1;2" надо arr(). Прошу помощи.
find по строгому соответствию содержимого, а не по его части
 
Здравствуйте.
Есть проблема с поиском нужной колонки в таблице данных. Таблица содержит шапку по которой идет поиск наименования. Несколько колонок имеют наименования с общим корнем Например: P400эконом, далее P400, RW100, RW10
код выглядит так:
name = P400
Set co = Range("аналоги").Offset(-1, 0).Find(What:=name, SearchOrder:=xlByRows)
В итоге возникает проблема. Как изменить поиск не по части текста , а по строгому соответствию?
Отсутствуют клавиши PAUSE, BREAK. Как останавливать процесс?
 
Здравствуйте. Собственно в названии темы вопрос. На данный момент приехал в офис с такой клавой. Заменить нечем. Пока думаю как переназначить кнопки если можно.
очистка значения в combobox userform и загрузка списков от вариантов выбора другого combobox
 
Добрый вечер. Столкнулся с проблемой смены контента одного combobox в зависимости от значения другого. Видел пример, где участвуют 3 комбо.(Родитель->потомок1->потомок2) , где по сути нужна фильтрация всех последующих зависимых потомков от значений их родителей. Не устраивает следущее : изменение значения в родителе (или потомке1) никак не влияет на обновление значения зависимых от него списков. Можно ли создать событие где зависимые списки очищались и в них загружался бы необходимый контент?
ошибка "subscript out of range" при использовании byref аргумента как массива
 
Здравствуйте уважаемые форумчане. Не смог понять характер вызываемой ошибки "subscript out of range" в подпроцедуре. Если подпроцедуру использовать самостоятельно как процедуру то ошибка не возникает. Большая просьба указать путь решения. Проблема в области моего непонимания. Пример приложил.
Макрос события листа не выдает задуманное условие
 
Здравствуйте. Даже не знаю как правильно сформулировать тему.
В первой колонке листа значения для ввода. Во второй значения бекапов значений первой колонки.
Макрос должен при вводе значения в ячейку первой колонки проверить равно или нет занчению во второй колонке. Если не равно то нужно сохранить бекап.
Короче я выкладываю пример, тк описать тяжко, хотя задачка банальна. Заблудился в 3 соснах.
пользовательская функция выдает ошибку #ЗНАЧ! при использовании на разных листах
 
Уважаемые форумчане!
Большая просьба посмотреть файл. В нем необходимая для меня функция не работает нормально. При переключении с листа на лист функция выдает ошибку  #ЗНАЧ!
Голову сломал уже.
Именованный диапазон по заданному условию в списках ячейки или combobox
 
Нужно чтобы без пробелов в списки попадали только те товары , цена на которые больше определенного значения. Табличку можно сделать "умной". Решать либо формулами либо макросами без разницы.
Запрет перетаскивания shapes
 
Доброй ночи. Нужно сделать запрет перетаскивания shapes на листе и изменения их размеров, кроме выделения мышкой пользователем. Причем запрет не должен распространяться на действие макросов над shapes. Лист предполагается защищать парольной защитой.
как обратиться к дочернему объекту shapes
 
На листе Shapes состоящая из нескольких сгруппированных линий. Нужно несколько линий сместить в сторону. Не пойму как обратиться к этим объектам. К сожалению на листе есть еще линии с аналогичными именами в других группах Shapes. Данные объеты получились путем копирования группы.
Страницы: 1 2 След.
Наверх