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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 След.
Запуск формы с координатами курсора мыши, VBA
 
Здравствуйте. Может другим участникам форума пригодится.
Переход на лист, Переход на предыдущий или следующий лист с помощью одного макроса на разных листах.
 
Здравствуйте. Эту тему смотрели?  По моему идеальный макрос.
UPD:
Цитата
New написал:
ActiveSheet.Next.Select
Тоже хорошее решение.
Изменено: DANIKOLA - 23.11.2022 00:53:51
Разный цвет текста в TextBox (UserForm)
 
Цитата
Дмитрий написал:
Вы запускали данный файл?
Десятки раз, все работает на отлично. Windows7 64-bit Office 2010 32-bit
Разный цвет текста в TextBox (UserForm)
 
Цитата
Дмитрий написал:
доступен только на Visual Basic
В смысле... А это что? RichTextBox.xlsm (49.73 КБ)
Разделить лист экселя на отдельные файлы
 
Здравствуйте.
Код
Sub CreateFilesByPageBreaks()
    Dim pb As HPageBreak, myRange As Range, CountHPageBreak As Integer
    Dim myRow As Long, newWorkBook As Workbook, i As Long
    If ActiveSheet.HPageBreaks.Count = 0 Then Exit Sub
    myRow = 0
    i = 1
    For Each pb In Worksheets(1).HPageBreaks
        If myRow > 0 Then
            Set myRange = Range(Cells(myRow, "A"), pb.Location.Offset(-1, 0).End(xlToRight))
            Set newWorkBook = Workbooks.Add
            myRange.Copy newWorkBook.Sheets(1).Cells(1)
            newWorkBook.Sheets(1).Columns.EntireColumn.AutoFit
            newWorkBook.Windows(1).View = xlPageBreakPreview
            newWorkBook.Windows(1).Zoom = 100
            newWorkBook.Close SaveChanges:=True, Filename:=ThisWorkbook.Path & "\" & i & Format(Now, " dd_MM_yy hh-mm-ss") & ".xlsx"
            i = i + 1
        End If
        myRow = pb.Location.Row
    Next pb
    CountHPageBreak = Worksheets(1).HPageBreaks.Count
    If Worksheets(1).HPageBreaks(CountHPageBreak).Location.Offset(1, 0).Value <> "" Then
        Set myRange = Range(Worksheets(1).HPageBreaks(CountHPageBreak).Location, Worksheets(1).HPageBreaks(CountHPageBreak).Location.Offset(1, 0).End(xlDown).End(xlToRight))
        Set newWorkBook = Workbooks.Add
            myRange.Copy newWorkBook.Sheets(1).Cells(1)
            newWorkBook.Sheets(1).Columns.EntireColumn.AutoFit
            newWorkBook.Windows(1).View = xlPageBreakPreview
            newWorkBook.Windows(1).Zoom = 100
            newWorkBook.Close SaveChanges:=True, Filename:=ThisWorkbook.Path & "\" & i & Format(Now, " dd_MM_yy hh-mm-ss") & ".xlsx"
    End If
End Sub

Sub CreateFilesByPageBreaks_V2()
    Dim pb As HPageBreak, myRange As Range, CountHPageBreak As Integer
    Dim newWorkBook As Workbook, i As Long
    If ActiveSheet.HPageBreaks.Count = 0 Then Exit Sub
    
    Application.ScreenUpdating = False
    
    For i = 1 To Worksheets(1).HPageBreaks.Count - 1
        Set myRange = Range(Worksheets(1).HPageBreaks(i).Location, Worksheets(1).HPageBreaks(i + 1).Location.Offset(-1, 0).End(xlToRight))
        Set newWorkBook = Workbooks.Add
        myRange.Copy newWorkBook.Sheets(1).Cells(1)
        newWorkBook.Sheets(1).Columns.EntireColumn.AutoFit
        newWorkBook.Windows(1).View = xlPageBreakPreview
        newWorkBook.Windows(1).Zoom = 100
        newWorkBook.Close SaveChanges:=True, Filename:=ThisWorkbook.Path & "\" & i & "Книга " & Format(Now, "dd_MM_yy hh-mm-ss") & ".xlsx"
    Next i
    CountHPageBreak = Worksheets(1).HPageBreaks.Count
    If Worksheets(1).HPageBreaks(CountHPageBreak).Location.Offset(1, 0).Value <> "" Then
        Set myRange = Range(Worksheets(1).HPageBreaks(CountHPageBreak).Location, Worksheets(1).HPageBreaks(CountHPageBreak).Location.Offset(1, 0).End(xlDown).End(xlToRight))
        Set newWorkBook = Workbooks.Add
        myRange.Copy newWorkBook.Sheets(1).Cells(1)
        newWorkBook.Sheets(1).Columns.EntireColumn.AutoFit
        newWorkBook.Windows(1).View = xlPageBreakPreview
        newWorkBook.Windows(1).Zoom = 100
        newWorkBook.Close SaveChanges:=True, Filename:=ThisWorkbook.Path & "\" & i & "Книга " & Format(Now, "dd_MM_yy hh-mm-ss") & ".xlsx"
    End If
End Sub
Переименовать файлы в папке
 
Здравствуйте. Гляньте, может подойдет, готовое решение.
Макрос для листа заставить работать на всей книге
 
Здравствуйте. Пробуйте, у нас не на чем пробовать, нету файла-примера.
Код
Sub УдалениеНулевыхСтрок()
    Dim sH As Worksheet, i As Long
    Application.ScreenUpdating = False
        For Each sH In ThisWorkbook.Worksheets
            If sH.Index > 5 Then
                With sH.UsedRange.Columns(2)
                    For i = .Rows.Count To 2 Step -1
                        If sH.Cells(i, 7).Value = 0 And sH.Cells(i, 7).Value <> "" Then sH.Rows(i).Delete
                    Next i
                End With
            End If
        Next sH
    Application.ScreenUpdating = True
End Sub

sH — списал у Ігор Гончаренко
Изменено: DANIKOLA - 30.10.2022 20:00:43
Получить список файлов в папке по условию
 
Здравствуйте. Пробуйте.
Цитата
wlad1164 написал:
список файлов которые были созданы либо изменены
Делал по "созданы", хотя при желании можете допилить под свои нужды, там несложно.
Если количество файлов больше 1048576(больше чем строк на листе), то выбирайте "В *.txt"
UPD:
Добавлена возможность выбора по дате создания и/или дате изменения.
UPD:
Добавлена опция запись списка файлов в текстовый файл.


P.S. Для выбора даты поставил TextBox, так-как DTPicker не у всех работает.
Изменено: DANIKOLA - 30.10.2022 16:00:04 (Улучшение и правка ошибок)
Преобразование ссылки, Преобразование текста ссылки в ссылку как таковую
 
Здравствуйте. Вот вроди готовое решение.
Строку с Range("Таблица1[Описание]").Select можно удалить, перед запуском макроса выделять Ваши гиперссылки вручную.
Изменено: DANIKOLA - 27.10.2022 19:18:46
Предотвратить переход в режим ожидания (спящий режим, отключение экрана, выход их системы в результате бездействия), VBA
 
Может так попробуйте:
Код
Sub TurnOffSleep()' вызвать вначале Вашего макроса
    Dim WshShell As Object, strCommand As String
    strCommand = " & powercfg -X -monitor-timeout-ac 0 & powercfg -X -disk-timeout-ac 0 & powercfg -X -standby-timeout-ac 0 & powercfg -X -hibernate-timeout-ac 0"
    Set WshShell = CreateObject("WScript.Shell")
    WshShell.Run "cmd.exe /C powercfg -h off " & strCommand, 1, False
End Sub

Sub TurnOnSleep()'вызвать вконце Вашего макроса
    Dim WshShell As Object, strCommand As String
    strCommand = " & powercfg -X -monitor-timeout-ac 30 & powercfg -X -disk-timeout-ac 90 & powercfg -X -standby-timeout-ac 90 & powercfg -X -hibernate-timeout-ac 120"
    Set WshShell = CreateObject("WScript.Shell")
    WshShell.Run "cmd.exe /C powercfg -h on " & strCommand, 1, False
End Sub

Цитата
webley написал:
закрытие окна плеера
Код
Sub TurnOffPlayer()
    Dim WshShell As Object
    Set WshShell = CreateObject("WScript.Shell")
    WshShell.Run "cmd.exe /C TASKKILL /IM vlc.exe", 1, False
End Sub

У меня плеер vlc, найдете в диспетчере задач в процессах точное имя Вашего видео-плеера, если будете использовать метод от webley.
Изменено: DANIKOLA - 25.10.2022 18:34:34
Массовое создание папок
 
Посмотрел Ваш файл, то там
Цитата
DANIKOLA написал:
новичкам или людям мало знакомым с VBA
вряд ли что-то будет понятно, Ваши тесты полезны продвинутым VBA-шникам, чтобы сразу применять самый быстрый способ. Ваш способ хорошо должен работать и в скрипте VBS, это на случай если нету установленного Офиса.
Я ориентировался на простого пользователя, возможно даже никак не связанного с Excel, если конечно таковый найдется...
Массовое создание папок
 
Всем доброго времени суток. Возможно на нашей планете(Excel) найдутся люди, которым иногда нужно создавать много однообразных папок с датой в имени или счётчиком плюс какие-либо префиксы/суффиксы, в общем рутина. Данная мини-программа создана для решения этой задачи. Конечно эта программа, скорее всего адресована новичкам или людям мало знакомым с VBA.

Работа в режиме «Дата»: выбираем начальную и конечную даты настраиваем формат даты, если нужно, в нем же можно добавлять свои префиксы и суффиксы по потребности, по умолчанию выставлен формат 01.12.2021, так же можно задать шаг с которым папки будут создаваться, типа: 01.12.2021, 03.12.2021, 05.12.2021…

Работа в режиме «Счётчик»: все точно так же, выбираем начальное и конечное числа, задаем формат…
*Если в форматировании даты или числа потребуется добавить латиницу, то обратите внимание на предпросмотр результата см. снизу красным, так-как некоторые латинские символы(c,d,e,h,m,n,q,s,w,y) участвуют в форматировании и даты, и чисел. Чтобы использовать эти символы, как обычный текст – каждый из них нужно экранировать левым слешем(\), типа: \M\y \t\ex\t dd.MM.yyyy, чтобы получить My text xx.xx.xxxx

Работа в режиме «Вручную»: просто печатаем имена папок через запятую.

Исходный код прилагается:Folders_creator_SourceCode.txt (17.97 КБ)
И сама программа:Folders creator.zip (132.83 КБ)

Создано в среде Visual Studio 2013 на языке Visual Basic, который в общем мало чем отличается от VBA. Портативная программа exe-файл.
Изменено: DANIKOLA - 24.10.2022 18:50:27 (Дополнил описание)
Сделать заглавными первые буквы каждой строки списка внутри ячейки, Поменять регистр первых букв в первом слове каждой строки списка, который находится внутри ячейки.
 
Здравствуйте. В строке "For Each Cell In Selection" Selection, можно заменить на конкретный диапазон, хотя выделить ваш даипазон с помощью Ctrl+Shift+⬇ вроди не сложно.
Код
Sub FirstLetterToUpperCase()
    Dim str As Variant, Cell As Range, newString As String, myItem
    
    For Each Cell In Selection
    str = Split(Cell.Value, Chr(10))
        For Each myItem In str
            newString = newString & Chr(149) & UCase(Left(myItem, 1)) & Right(myItem, Len(myItem) - 1) & vbLf
        Next myItem
        newString = Left(newString, Len(newString) - 1)
        Cell.Value = newString
        newString = vbNullString
    Next Cell
    
End Sub
Обнуление переменной!
 
Здравствуйте.
Код
Set rr0 = Nothing
Макрос для перехода по листам
 
Здравствуйте NewMaestro.
Цитата
NewMaestro написал:
Надо написать пару макросов
Цитата
Николай Павлов в правилах написал:
2.6. Один вопрос - одна тема. Не следует в открываемой теме обозначать и задавать сразу несколько вопросов.
Вообще не понятно, как должен работать макрос. Ниже строчка кода активирует лист по заданному имени в кавычках.
Код
Worksheets("Лист1").Activate

Может должна быть форма с кнопками или листбоксом?
---
UPD:
Вот статейку гляньте, может подойдет.
---
UPD:
Александр Моторин   Вы показали отличный макрос, спасибо.
Изменено: DANIKOLA - 08.10.2022 15:31:55
Макрос создания текстовых файлов с названиями из ячеек, создание текстовых файлов из ячеек книги Excel
 
Здравствуйте. Вот, если хотите, гляньте в файле в коде все показано, как работать с текстовыми файлами. Без файла-примера с Вашей стороны, врядли кому-то будет интересно рисовать файл-пример вместо Вас, чтобы Вам же помочь решить задачу.
VBA Назначить одну команду всем кнопкам в диапазоне
 
Еще можно добавить кнопки(и чекбоксы  в том числе) простым протягиванием ячейки за черный крестик, как протягивается обычная формула. Сначала создаем кнопку(элементы управления формы), подгоняем размер кнопки, чтобы она была внутри ячейки, назначаем кнопке макрос и просто протягиваем ячейку за крестик.
Изменено: DANIKOLA - 13.09.2022 13:10:17
VBA Назначить одну команду всем кнопкам в диапазоне
 
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    MsgBox Target.Row
End Sub

Если не знаете куда код вставлять, подучите события листа Excel.
Вариант2, можно макрос вызова формы добавить на кнопку в панели быстрого доступа, та что с самого верху.
Вариант3, сделать маленькую форму с одной кнопкой, клик по которой будет вызывать главную форму. Прокрутка и фильтр не будет влиять на положение маленькой формы.
P.S. Большое количество кнопок негативно повлияет на размер файла.
Изменено: DANIKOLA - 13.09.2022 11:44:21
VBA. Выделение искомого текста в выбранном диапазоне ячеек
 
Цитата
БМВ написал:
lngMach = InStr(1, Cell.Text, Me.TextBox1.Text, vbComparison)
Да, походу это лишняя строка.
Сделал правки по Вашей подсказке БМВ.
Код

О, и с буквами АА..., тоже чуток поправил, не идеально конечно...
Изменено: DANIKOLA - 04.09.2022 15:20:21
VBA. Выделение искомого текста в выбранном диапазоне ячеек
 
Всем доброго времени суток. Этот макрос является ответом на вопрос: "Как выделить искомое слово в ячейках? Именно слово, а не ячейку". Может кому-то пригодится.

Не совсем слово, скорее всего текст...
---UPD---
Цитата
Jack Famous написал:
Было бы удобнее оценить код
Вот пожалуйста:
Code
Изменено: DANIKOLA - 04.09.2022 13:10:26 (Добавил код по просьбе Jack Famous)
Универсальный обработчик событий контролов юзерформы
 
Здравствуйте user0, как-то интересовался этой темой, не скажу что я её до конца понял, но рабочий код нашел(переписал с книги) и сохранил.
Правда некоторых событий характерных для тексбокса в модуле класса не хватает.
Список событий текстбокса в модуле класса:

Обычный список событий текстбокса:
Редактировать URL с помощью формулы
 
Здравствуйте.
Формула: =ПРОПНАЧ(СЖПРОБЕЛЫ(ПОДСТАВИТЬ(ПСТР(A1;26;ПОИСК("/";A1;26)-26);"-";" ")))
Прекращение всех процедур в модуле VBA
 
Добрый день alexpet, попробуйте использовать глобальную переменную булевого типа и при нужной вам проверке задать ей True или False, а в последующих процедурах в самом начале делать проверку этой переменной.
P.S. Может ваш кусок кода оформите соответствующим тегом<...>, чтобы было читабельней.
Макрос: Копирование значений листа «Сегодня» в «Архив»., Кнопкой, переместить строки рабочего листа, в лист архивный.
 
Здравствуйте Мария Филипова, вот пробуйте.
Код
Sub clean_tab()
    Range("B4" & ":" & "B" & Range("C4").End(xlDown).Row, Range("N4")).ClearContents
End Sub
Sub CopyData()
    Range("B4" & ":" & "B" & Range("C4").End(xlDown).Row, Range("N4")).Copy _
    Sheets("Архив").Range("B3").End(xlDown).Offset(1, 0)
End Sub
Перенос кода макроса прописанного на листе в другой, только что созданный лист с помощью макроса
 
Здравствуйте.
Цитата
Jack Famous написал:
одно событие для всех листов
Код модуля
Код
Private xlApp As ClassEventsxlApp

Private Sub Workbook_Open()
    Set xlApp = New ClassEventsxlApp
End Sub

Код модуля класса
Код
Private WithEvents xlApp As Application

Private Sub Class_Initialize()
    Set xlApp = Application
End Sub

Private Sub xlApp_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    MsgBox Sh.Parent.Name
End Sub
Private Sub xlApp_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    MsgBox Sh.Name & vbCrLf & Target.Address(0, 0)
End Sub

---
Цитата
Андрей Нечитаев написал:
Спасибо, разобрался
Поделитесь с людьми, как решили, интересно ведь...
Вставка картинок с помощью макроса и подгон размера картинок под размер ячеек (пакетно)
 
Здравствуйте. Смотрели? ==>Вставка картинок и изображений в ячейки листа Excel
Удалить макросом "Поле со списком (элемент управления формы)"
 
Здравствуйте. Антиспам съел ваше сообщение, но судя по названию темы, возможно вам подойдет это: Удаление элементов ActiveX с рабочего листа.
Или если не разберетесь, прикрепите файл с тем самым "Поле со списком" — напишем макрос удаления.
Изменено: DANIKOLA - 09.07.2022 18:14:42
Поменять двоеточие между числами на пробелы через формулу или лучше макросом, Замена дветочий между числами на пробелы
 
Cristal, в пустую ячейку где должен быть результат пишем формулу =ПОДСТАВИТЬ(A1;":";" "),  А1 — это ячейка с вашими цифрами "1:7:10:15:26:34...", т.е., вместо А1 может быть В1, кроче - это адресс ячейки с цифрами.
Изменено: DANIKOLA - 02.07.2022 17:02:21
Поменять двоеточие между числами на пробелы через формулу или лучше макросом, Замена дветочий между числами на пробелы
 
Добрый день. Формула: =ПОДСТАВИТЬ(A1;":";" ")
Нумерация в таблици после строки с символом с начала
 
Добрый день. Вот пожалуйста: Нумерация в табл.+.xlsm (18.17 КБ)
Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 След.
Наверх