Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 След.
Ошибка при копировании листа с "умной таблицей" макросом.
 
Igor67, о господи, какое прекрасное решение. Даже табличка такой же красивой получается, а если она отфильтрована, то копируется только отфильтрованное.  
открыть последний файл в папке по дате создания
 
Ребята, у меня на Виндовсе 10 этот скрипт не работал должным образом. Я его немного подправил.
Суть в том, что у меня в переменную t скрипта Максим Зеленский на 12 строке, попадает, после первого прогона в цикле, дата самого старого файла, из-за этого ломалось выполнение условия в строке: " If CDate(myFile.DateCreated) < t Then" (11 строка), так как ВБА искало мне файлы старее самого старого файла, что нелогично.

А вот так работает:
Код
Sub get_first_created()

Dim myPath$, mask$, f$, i%, t As Date
Dim myFolder As Object, myFile As Object
myPath = "C:\Users\obarsukov\Downloads" ' директория для поиска
mask = "*.xls" ' маска поиска с * и ?
t = Now 
a = 1

With CreateObject("Scripting.FileSystemObject")
    Set myFolder = .GetFolder(myPath)
    For Each myFile In myFolder.Files
        If myFile.Name Like mask And a = 1 Then
            If CDate(myFile.DateCreated) <= t Then
                t = CDate(myFile.DateCreated)
                f = myFile.Name
                a = 0
            End If
            
        Else
             If CDate(myFile.DateCreated) > t Then
                t = CDate(myFile.DateCreated)
                f = myFile.Name
                
            End If
        
        End If
    Next
End With
If f <> "" Then MsgBox "File found: " & f & ", " & t Else MsgBox "No such file"
End Sub
Изменено: Arrio - 09.10.2021 19:33:26
DoEvents ... Loop не даёт открывать другие книги Эксель в процессе работы.
 
DoEvents Loop не даёт открывать другие книги Эксель в процессе работы, в то время, как мне это необходимо.
Не могли бы Вы мне помочь, как можно открывать Эксель Книги не прерывая цикла?
Код
Private Sub Label111_Click()

While DoEvents()    
    Label111 = Format(Now, "h:mm:ss AM/PM") 'Код, работающий в процессе цикла ожидания    
Loop

End Sub
Немодальная UserForm без шапки, с прозрачностью и возможностью перетаскивания
 
Alemox, спасибо, всё работает!)
Только непонятно как и почему..)
Вот так работает (взял только часть кода):

Код
Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    OldX = X
    OldY = Y
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 1 Then
        Me.Left = Me.Left + (X - OldX)
        Me.Top = Me.Top + (Y - OldY)
    End If
End Sub

А вот так не работает, хотя шапки "UserForm_MouseDown(ByVal B.........", вроде как одинаковы и закинуть действия под одну крышу вроде бы можно (НО нельзя, ибо не работает):
Код
Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    OldX = X
    OldY = Y

    If Button = 1 Then
        Me.Left = Me.Left + (X - OldX)
        Me.Top = Me.Top + (Y - OldY)
    End If
End Sub 
Изменено: Arrio - 11.12.2019 11:14:18
Немодальная UserForm без шапки, с прозрачностью и возможностью перетаскивания
 
Это модераторы сменили название темы)
Немодальная UserForm без шапки, с прозрачностью и возможностью перетаскивания
 
Вот частичное решение задачи. Форма прозрачная, без заголовка, отображается поверх всех окон, но не могу привинтить сюда перемещение за тело.
Код
Private Declare PtrSafe Function FindWindow _
       Lib "user32.dll" Alias "FindWindowA" ( _
       ByVal lpClassName As String, _
       ByVal lpWindowName As String) As Long
       
Private Declare PtrSafe Function GetWindowLong _
       Lib "user32.dll" Alias "GetWindowLongA" ( _
       ByVal hWnd As Long, _
       ByVal nIndex As Long) As Long
       
Private Declare PtrSafe Function SetWindowLong _
       Lib "user32.dll" Alias "SetWindowLongA" ( _
       ByVal hWnd As Long, _
       ByVal nIndex As Long, _
       ByVal dwNewLong As Long) As Long
       
Private Declare PtrSafe Function DrawMenuBar Lib "user32.dll" ( _
       ByVal hWnd As Long) As Long
       
       Private Declare PtrSafe Function SetLayeredWindowAttributes _
        Lib "user32.dll" ( _
        ByVal hWnd As Long, _
        ByVal crKey As Long, _
        ByVal bAlpha As Long, _
        ByVal dwFlags As Long) As Long
       
       Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hWnd As LongPtr, _
     ByVal hWndInsertAfter As LongPtr, _
     ByVal X As Long, ByVal Y As Long, _
     ByVal cx As Long, ByVal cy As Long, _
     ByVal wFlags As Long) As Long
Private Const HWND_NOTOPMOST = -2
Private Const HWND_TOPMOST = -1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
 

Private Sub UserForm_Initialize()
   Dim ihWnd As Long, iStyle As Long
 
   ihWnd = FindWindow(vbNullString, Me.Caption)
   iStyle = GetWindowLong(ihWnd, -16&)
   SetWindowLong ihWnd, -16&, iStyle And Not &HC00000
   DrawMenuBar ihWnd
   
   Dim hWnd As LongPtr
  hWnd = FindWindow(vbNullString, Me.Caption)
      Call SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, WP_NOMOVE Or SWP_NOSIZE)
'*******Форма в нормальное положение**************
'       Call SetWindowPos(hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
'**********************************************

UserForm1.Left = 875
 UserForm1.Top = 600
 
 SetWindowLong ihWnd, -20&, iStyle Or 524288
    SetLayeredWindowAttributes ihWnd, 0&, 100&, 2&
End Sub
Нужно эти 2 кода скрестить (нижний позволяет таскать за тело форму без шапки).
Прошу помочь.
Код
Option Explicit
    'константы для функций API
    Private Const GWL_STYLE As Long = -16& 'для установки нового вида окна
    Private Const GWL_EXSTYLE = -20& 'для расширенного стиля окна
    Private Const WS_CAPTION As Long = &HC00000 'определяет заголовок
    Private Const WS_BORDER As Long = &H800000 'определяет рамку формы
    
    Private Const WM_NCLBUTTONDOWN = &HA1
    Private Const HTCAPTION = 2
    
    'Функции API, применяемые для поиска окна и изменения его стиля

    Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
    
    
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare PtrSafe Sub ReleaseCapture Lib "user32" ()
    
    Dim ihWnd As Long

    Private Declare PtrSafe Function SetWindowPos Lib "user32.dll" ( _
        ByVal hWnd As Long, _
        ByVal hWndInsertAfter As Long, _
        ByVal X As Long, _
        ByVal Y As Long, _
        ByVal cx As Long, _
        ByVal cy As Long, _
        ByVal wFlags As Long) As Long

Private Sub UserForm_Initialize()
    Dim hStyle
    'ищем окно формы среди всех открытых окон
    If Val(Application.Version) < 9 Then
        ihWnd = FindWindow("ThunderXFrame", Me.Caption) 'для Excel 97
    Else
        ihWnd = FindWindow("ThunderDFrame", Me.Caption) 'для Excel 2000 и выше
    End If
    'получаем информацию о найденном окне(стили и т.д.)
    hStyle = GetWindowLong(ihWnd, GWL_STYLE)
    'назначаем переменной новый стиль для окна формы
    hStyle = hStyle And Not WS_CAPTION And Not WS_BORDER
    'изменяем вид окна: убираем меню(заголовок) и рамку
    SetWindowLong ihWnd, GWL_STYLE, hStyle
    SetWindowLong ihWnd, GWL_EXSTYLE, 0
    'перерисовываем форму, точнее строку меню(заголовка)
    DrawMenuBar ihWnd
    'меняем размер формы, т.к. сделали смещение элементов формы вверх на высоту заголовка
    Me.Height = Me.Height + GWL_EXSTYLE
End Sub

Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 1 Then
        ReleaseCapture
        SendMessage ihWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
    End If
End Sub

В файлике в первой Юзерформ первый код, во второй - второй.  
Изменено: Arrio - 10.12.2019 17:51:23
Событие "если выбран любой пункт в срезе" таблицы автоматически запускать макрос., Не могу решить задачу запуска макроса по клику в срез.
 
- Дано: Есть умная таблица к которой прикреплён срез. И есть макрос скрытия пустых столбцов.
- Задача: запускать макрос скрытия пустых столбцов (уже написан) после клика на срез.
- Проблема: если прикрепить макрос к срезу то элементы среза нажать невозможно. Порыскав по интернету я понял что такого события не существует для добавления в модуль листа.

Прошу помочь выкрутиться из этого положения.

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

- Доп. инфа: на странице только 1 срез и только они осуществляет фильтрацию.

Просьба помочь. Спасибо.
Изменено: Arrio - 30.05.2019 15:49:00
Запуск макроса поворотом колеса мыши вниз и вверх
 
Уважаемые знатоки, поискав информацию по поводу запуска макроса поворотом колеса мыши я рабочего ответа не нашёл. Просьба помочь мне с этим. Как запускать макросы поворотом колеса вниз (первый макрос) и вверх (второй макрос)?
Изменено: Arrio - 30.05.2019 08:23:58
Макрос скрытия пустых столбцов
 
Каеф. Тему распечатал и повесил на рабочем месте рядом с иконой. Скоро крестиком вышью. Спасибо за крутые идеи!).
Суммировать числа, записанные с буквой
 
RAN, Jack Famous, БМВ, спасибо за внимание, проблема решена.
Суммировать числа, записанные с буквой
 
БМВ, Готово!
Код
Function КОПЛАТЕ(нач As Range, Смена, Минуты) 'если кто будет тестить у себя в файле, в семну и минуты время забивается так 1/24 - час, 1/48 - пол часа и тд.
'нач - Ячека, в которой записан диапазон вида "10:00-11:00", Смена - Длительность смены, от которой нужно отнимать перерыв,
'Минуты - колличество отнимаемых минут.
'Работает при формате ячейки [h]:mm

Dim Cell As Range   ' просто объявляем переменную
For Each Cell In нач 'простецкий счётчик, который позволяет поочерёдно перебать значения в диапазоне
Cell2 = Cell '_голову_сломал_но_так_работает. Это не лишняя строка!


If Cell2 = 0 Then 'если в ячейке 0, то писать 0
    КОПЛАТЕ = 0
Else
    
    ФОРМАТ3 = Application.Substitute(Cell2, ",", ":") 'меняем запятую на двоеточие
    ФОРМАТ2 = Application.Substitute(ФОРМАТ3, ".", ":") 'меняем точку на двоеточие
    ФОРМАТ1 = Application.Substitute(ФОРМАТ2, " ", "") 'удаляем пробелы
    ФОРМАТНАЧАЛО = Application.Sum(Application.Replace(ФОРМАТ1, Application.Search("-", ФОРМАТ1, 1), 99, "")) 'отделяем от диапазона "10:00-11:00" его начало "10:00"
    ФОРМАТКОНЕЦ = Application.Sum(VBA.Mid(ФОРМАТ1, Application.Search("-", ФОРМАТ1, 1) + 1, 99)) 'отделяем от диапазона "10:00-11:00" его конец "10:00"



        If ФОРМАТКОНЕЦ < ФОРМАТНАЧАЛО Then 'устраняем ошибку полуночных смен
           ДЛИНА_СМЕНЫ = ФОРМАТКОНЕЦ + 24 / 24 - ФОРМАТНАЧАЛО 'для ночи
        Else
            ДЛИНА_СМЕНЫ = ФОРМАТКОНЕЦ - ФОРМАТНАЧАЛО 'для дня
        End If
    
    
        If ДЛИНА_СМЕНЫ < Смена Then 'отнимаем перерыв
            КОПЛАТЕ2 = ДЛИНА_СМЕНЫ
        Else
            КОПЛАТЕ2 = ДЛИНА_СМЕНЫ - Минуты
        End If
End If
КОПЛАТЕ = КОПЛАТЕ2 + КОПЛАТЕ
Next Cell

End Function
Изменено: Arrio - 06.05.2019 14:16:08
Суммировать числа, записанные с буквой
 
БМВ, как то так. Сейчас буду связывать 2 формулы.

Код
Function ТЕСТ(Тест1 As Range)

Dim Cell As Range   ' просто объявляем переменную
For Each Cell In Тест1 'простецкий счётчик, который позволяет поочерёдно перебать значения в диапазоне
Cell2 = Cell '_голову_сломал_но_так_работает. Это не лишняя строка!

    If Cell2 > 0 Then       'тут может быть любое условие, или функция, а Cell2 принимает поочерёдно все значения в диапазоне
        ТЕСТ = ТЕСТ + Cell2          'к результату функции ТЕСТ прибавляем каждый раз новую ячейки, которые перебираются в Cell2 по всему указанному диапазону
    Else
        ТЕСТ = 0
    End If

Next Cell


End Function
Изменено: Arrio - 06.05.2019 10:26:43
Суммировать числа, записанные с буквой
 
БМВ, все равно не могу понять как дополнить вот эту формулу что бы и диапазоны обсчитывала. Смысл в том что бы формула разрывала формат 10:00-11:00 и высчитывала длину смены, после чего суммировала все длины смен.
Код
Function КОПЛАТЕ(нач, Смена, Минуты)
'нач - Ячека, в которой записан диапазон вида "10:00-11:00", Смена - Длительность смены, от которой нужно отнимать перерыв,
'Минуты - колличество отнимаемых минут.
'Работает при формате ячейки [h]:mm

If нач = 0 Then 'если в ячейке 0, то писать 0
    КОПЛАТЕ = 0
Else
    
    ФОРМАТ3 = Application.Substitute(нач, ",", ":") 'меняем запятую на двоеточие
    ФОРМАТ2 = Application.Substitute(ФОРМАТ3, ".", ":") 'меняем точку на двоеточие
    ФОРМАТ1 = Application.Substitute(ФОРМАТ2, " ", "") 'удаляем пробелы
    ФОРМАТНАЧАЛО = Application.Sum(Application.Replace(ФОРМАТ1, Application.Search("-", ФОРМАТ1, 1), 99, "")) 'отделяем от диапазона "10:00-11:00" его начало "10:00"
    ФОРМАТКОНЕЦ = Application.Sum(VBA.Mid(ФОРМАТ1, Application.Search("-", ФОРМАТ1, 1) + 1, 99)) 'отделяем от диапазона "10:00-11:00" его конец "10:00"



        If ФОРМАТКОНЕЦ < ФОРМАТНАЧАЛО Then 'устраняем ошибку полуночных смен
           ДЛИНА_СМЕНЫ = ФОРМАТКОНЕЦ + 24 / 24 - ФОРМАТНАЧАЛО 'для ночи
        Else
            ДЛИНА_СМЕНЫ = ФОРМАТКОНЕЦ - ФОРМАТНАЧАЛО 'для дня
        End If
    
    
        If ДЛИНА_СМЕНЫ < Смена Then 'отнимаем перерыв
            КОПЛАТЕ = ДЛИНА_СМЕНЫ
        Else
            КОПЛАТЕ = ДЛИНА_СМЕНЫ - Минуты
        End If
End If
End Function
Изменено: Arrio - 05.05.2019 12:09:12
Суммировать числа, записанные с буквой
 
Если кто ещё и счётчиком сможет написать, буду благодарен.
Суммировать числа, записанные с буквой
 
Зачитательно! Спасибо большое!
Изменено: ArRiO - 03.05.2019 18:55:38
Суммировать числа, записанные с буквой
 
БМВ, не сочтите за грубость, но было бы это так просто найти, я бы не обратился бы.
Суммировать числа, записанные с буквой
 
БМВ, разрешите поинтересоваться о назначении синтаксиса --
Изменено: ArRiO - 03.05.2019 18:22:51
Суммировать числа, записанные с буквой
 
БМВ, поправил описание.
Суммировать числа, записанные с буквой
 
Благодарю, но сюда мне не всунуть предварительный пропуск через формулу.
Суммировать числа, записанные с буквой
 
Здравствуйте, знатоки. Не могу найти ответ, как сначала применить формулу к заданному диапазону, а потом просуммировать значания , пропущенные через формулу БЕЗ создания дополнительных столбцов.

А так же, как это записать в пользовательскую формулу, если есть такая возможность.

Так же классно бы было получить более-менее универсальный приём, через счётчики, для суммирования значений выбранного диапазона  через пользовательской функцию в который потом можно будет подставить любую формулу для предварительного форматирования перед суммированием? А я уже туда поставлю нужную формулу.
Спасибо.

К примеру диапазон чисел 1а,2а,3а,4а,5а. Записанные в столбик. Что бы сначала она удалила букву "а", а потом просумировала значения. И все одной формулой без доп. столбов, не через СТРЛ Ф.
Изменено: ArRiO - 05.05.2019 20:33:13
Автоматизация вставки текста из Эксель в поле произвольной программы, Работаю в чате, помогите
 
magistor8
SendKeys "^c" - имитация Ctrl C не работает, почему-то. Скорее всего по тому что я не подключил функцию API Windows какую-то (одной из тех непонятных строк, что Вы мне прислали.)
Заменил на ActiveCell.Copy (копировать активную ячейку)

Теперь бы ещё научится находить программу по части имени, а не по 100% совпадению.  
Изменено: ArRiO - 06.04.2019 23:17:44
Автоматизация вставки текста из Эксель в поле произвольной программы, Работаю в чате, помогите
 
sokol92, рассматриваю Ваш вариант. Не могу разобраться как это работает и как активируется и вообще как это, блин, запустить и протестить, хотя бы на калькуляторе. Гугл в помощь! Когда разберусь, отпишусь.  
Автоматизация вставки текста из Эксель в поле произвольной программы, Работаю в чате, помогите
 
magistor8, вот так работает безотказно! Это на основе Вашего кода.

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Const SW_SHOWNORMAL = 1&
Public Status As Integer

''''''''''''''' Активирует окно по названию '''''''''''''''''''''''''''''''''''''
Sub вот()
Dim hwnd&
hwnd = FindWindow(vbNullString, "НАЗВАНИЕ ПРОГРАММЫ")
If hwnd <> 0 Then 'Если открыто
ShowWindow hwnd, SW_MINIMIZE 'свернуть
   ShowWindow hwnd, SW_SHOWNORMAL 'развернуть
Else 'Если нет
   Exit Sub
End If
End Sub
Изменено: ArRiO - 06.04.2019 22:13:20
Автоматизация вставки текста из Эксель в поле произвольной программы, Работаю в чате, помогите
 
Слишком много посторонних документов открыто что бы ограничится Alt+tab. Не всегда удобно. Я сейчас перед раскрытием попробую насильно сворачивать окно. Надеюсь получится.
Изменено: ArRiO - 06.04.2019 11:39:59
Автоматизация вставки текста из Эксель в поле произвольной программы, Работаю в чате, помогите
 
1. По поводу "скинуться" это к сожалению не вариант. Простите.  Однако я могу от себя что-то платить за решение особенно каверзных тупиковых вопросов.
2. По поводу ответа Magistor8. Очень ёмко. Сейчас по частям подналаживаю Ваш скрипт. Уже в первой части ShowWindow hwnd открывает моего подопытного поверх других окон "Calculator" только из позиции "свернуто", а нужно что бы даже когда он развернут он становился поверх других окон и " загорался" активным окном.
3. Hogo, я не могу ставить стороннее ПО.. (

Спасибо что дали ветор мышления.
Это WinApi называется? Он в полной мере в VBA поддерживается или есть какие-то ограничения? Где про это почитать можно?
Изменено: ArRiO - 05.04.2019 17:45:18
Автоматизация вставки текста из Эксель в поле произвольной программы, Работаю в чате, помогите
 
Спасибо. Сейчас буду пробовать. Помимо меня 40 человек желают что бы это заработало. Я очень надеюсь что всё будет ок.
Автоматизация вставки текста из Эксель в поле произвольной программы, Работаю в чате, помогите
 
Ркдактировал описание. Программа хороша, но у меня очень много шаблонов, мне необходим Эксель для их фильтрования и сортировки.
Изменено: ArRiO - 05.04.2019 15:02:22
Автоматизация вставки текста из Эксель в поле произвольной программы, Работаю в чате, помогите
 
 Я всегда копирую только одну ячейку. Другая программа принимает Контрл В. По движениям. Клик ячейка - контрл ц - клик программа - клик поле - контрл в.
Автоматизация вставки текста из Эксель в поле произвольной программы, Работаю в чате, помогите
 
Предлагаю следующие название. Автоматизация вставки текста из Эксель в поле произвольной программы.

Например калькулятора Виндовс (не могу придумать лучше). Но точно не блокнота и ворда.
Автоматизация вставки текста из Эксель в поле произвольной программы, Работаю в чате, помогите
 
Есть возможность поменять название темы не удаляя её?
Страницы: 1 2 След.
Наверх