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

Страницы: 1 2 След.
Макрос удаления строк по условию
 
Приветствую всех!
Как должен выглядеть этот код, если вместо текста типа "апельсин", в таблице числовые данные (и целые и нецелые числа),  а удалить (ну или переместить) нужно строки, значения в которых меньше (или больше) заданной величины. К примеру если по тому же столбцу "C" значения меньше 500 ?
Спасибо !
Работа по оптимизации кода, Ускорение работы макроса сборки данных
 
Огромное спасибо автору "New".
Задача успешно решена и все договорённости состоялись.
Всем удачи и процветания!  
Работа по оптимизации кода, Ускорение работы макроса сборки данных
 
Код
Option Private Module




Sub Удалить_Пустоты() ' перебор ячеек диапазона в поисках значения "ТекстДляПоиска"

    Dim cell As Range, delra As Range, ТекстДляПоиска As String
    Application.ScreenUpdating = False
 
    ТекстДляПоиска = ""
 
    For Each cell In Range("C1:C50000").Cells
        If cell = ТекстДляПоиска Then
            If delra Is Nothing Then Set delra = cell Else Set delra = Union(delra, cell)
        End If
    Next

'Это если подходящие строки найдены - удаляем их
    If Not delra Is Nothing Then delra.EntireRow.Delete
    End Sub
Sub дубли()
'

   Range("A2:N50000").Select
    ActiveSheet.Range("$A$3:$N$50000").RemoveDuplicates Columns:=3, Header:= _
        xlYes
End Sub

Private Sub CommandButton1_Click()
  If MsgBox("Напечатать загруженный диапазон?", vbYesNo) = vbNo Then
     Exit Sub
  Else
 ' Шрифт белый
    Nav = [Строк] + 2
    Range("L3", Cells(Nav, 14)).Select
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
'

  Application.Goto Reference:="Загружен"
  Selection.PrintOut 'печать выделенного диапазона
   

' ' Шрифт чёрный
    Nav = [Строк] + 2
    Range("L3", Cells(Nav, 14)).Select
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
  End If
End Sub


Sub Загрузить_остатки()
 
 If Dir("C:\Ревизия\Импорт\*.*xls") = "" Then
MsgBox "нет файла"
 Exit Sub
Else
    
  Application.ScreenUpdating = False ' True
  Sheets("Инвентаризационная_ведомость").Select
  

  Columns("L:L").Select
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    
    Range("L2").Select
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
'--------------------------

'' форматируем наименование, цену МХ


'---------------------
  
  Const TargDir$ = "C:\Ревизия\Импорт\", Sht& = 1
  Dim wb As Workbook, fn$
'  Application.ScreenUpdating = False
  With Workbooks.Add.Worksheets(1)
    .Cells(1) = 1: fn = Dir(TargDir & "*.xls*")
    Do While fn <> ""
      Set wb = Workbooks.Open(TargDir & fn)
      If wb.Worksheets.Count >= Sht Then _
        wb.Worksheets(Sht).UsedRange.Copy .Cells(.UsedRange.Rows.Count + 1, 1)
        wb.Close False: fn = Dir
    Loop
    
  End With
   
 
   ' УдалениеСтрокПо_Значению_в_диапазоне() ' перебор ячеек диапазона в поисках значения "da"
    Dim cell As Range, delra As Range, ТекстДляПоиска As String
    Application.ScreenUpdating = False

    ТекстДляПоиска = ""
    For Each cell In Range("F1:F30000").Cells
        If cell = ТекстДляПоиска Then
            If delra Is Nothing Then Set delra = cell Else Set delra = Union(delra, cell)
        End If
    Next
    ТекстДляПоиска1 = "Ед."
    For Each cell In Range("F1:F30000").Cells
        If cell = ТекстДляПоиска1 Then
            If delra Is Nothing Then Set delra = cell Else Set delra = Union(delra, cell)
        End If
    Next
    If Not delra Is Nothing Then delra.EntireRow.Delete
'
    Range("A" & Rows.Count).End(xlUp).Offset(0).Select  'Последняя строка +0
    ActiveCell.Offset(0, 11).Select 'Перейти на X шагов вниз и на Y вправо
    ActiveCell.FormulaR1C1 = "0"
    ActiveCell.Offset(0, 2).Select
    ActiveCell.FormulaR1C1 = "0"
    Range("L1").FormulaR1C1 = "=RC[-5]"
    Range("L1").Select
    Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
   


    book = ActiveWorkbook.Name
    Columns("L:L").Select
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With

    Range("L2").Select
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With


    ActiveSheet.UsedRange.Select 'Выделяет заполненную таблицу

    Selection.Copy
    ThisWorkbook.Activate
    Sheets("Инвентаризационная_ведомость").Select
    Range("A" & Rows.Count).End(xlUp).Offset(1).Select  'Последняя строка +1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    ' Создать_диапазон()
    ActiveWorkbook.Names.Add Name:="Загружен", RefersToR1C1:="=" & Selection.Parent.Name & "!" & Selection.Address(ReferenceStyle:=xlR1C1)
    Calculate
    


    Windows(book).Activate
    Application.CutCopyMode = False ' Очистить буфер памяти
    ActiveWindow.Close False 'закрыть без запроса на сохранение

    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
'    Перемещаем файлы в другую папку
    fso.MoveFile "C:\Ревизия\Импорт\*.xls", "C:\Ревизия\Загруженные\"

    ThisWorkbook.Activate
    Sheets("Инвентаризационная_ведомость").Select

    End If


    Range("A3:M3").Copy
    Range("A4", Cells(Nav, 13)).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

    Nav = [Строк] + 2
    Range("N3").FormulaR1C1 = "=RC[-2]-RC[-7]"

    Range("N3").Copy
    Range("N4", Cells(Nav, 14)).Select
    ActiveSheet.Paste

    Application.CutCopyMode = False ' Очистить буфер памяти
'


    Call дубли
    Call Удалить_Пустоты

    Nav3 = [Строк] + 2
    Range("A3", Cells(Nav3, 3)).Value = Range("A3", Cells(Nav3, 3)).Value ' Весь массив заменяем значениями
    Columns("L:L").Select
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    Range("L2").Select
    ActiveSheet.Range("$A$3:$N$50000").RemoveDuplicates Columns:=3, Header:= _
        xlYes
    
    ' форматируем границы таблицы
    Cells.Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

   
    Range("Загружен").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    
   ' Место хранения вправо
  Nav = [Строк] + 2
  Range("B2", Cells(Nav, 1)).Select
  With Selection
        .HorizontalAlignment = xlRight
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    ' Цена с копейками
'
    Nav = [Строк] + 2
    Range("H3", Cells(Nav, 8)).Select
    Selection.NumberFormat = "0.00"
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    ' Наименование переносить по словам
'
  Nav = [Строк] + 2
    Range("E3", Cells(Nav, 5)).Select
  With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    ' Формат вправо
'
  Nav = [Строк] + 2
    Range("C3", Cells(Nav, 3)).Select
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
  Nav = [Строк] + 2
    Range("G3", Cells(Nav, 14)).Select
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

    
    Calculate
      
'    Application.Goto Reference:="Загружен"
'    Call CommandButton1_Click
    
    
    ' Удалить_диапазон()
   Application.Goto Reference:="Загружен"
   ActiveWorkbook.Names("Загружен").Delete
'    Call Valid



    ActiveSheet.DisplayPageBreaks = False ' устраняет мерцание кнопок
    Application.ScreenUpdating = True 'False ' True
''
'     End If
End Sub



Sub Очистить_Рукописку()
'


'
    Application.ScreenUpdating = False 'False ' True
    Sheets("Инвентаризационная_ведомость").Select
    
    If [Строк] < 2# Then
    Exit Sub
    End If
    Nav = [Строк] + 3
   

    Range("A3", Cells(Nav, 15)).Select
    Selection.Delete Shift:=xlUp
    Range("A3:N3").ClearContents
    Range("A3").Select
'    Call Valid
    
    Application.ScreenUpdating = True 'False ' True
    

End Sub


Вот сам код:
Всем Спасибо !
Работа по оптимизации кода, Ускорение работы макроса сборки данных
 
Жители "планеты Excel "? приветствую Вас!
Есть работающий макрос. Составлен из кучи решений и подсказок разных авторов Планеты Excel из разных времён.
Макрос работает.
При загрузке небольших массивов данных всё было хорошо (терпимо).
Но  при загрузке больших объёмов данных (50-60 листов) макрос тормозит.
Я никогда не занимался "оптимизацией кода" и предполагаю что специалистам на "мой" код смотреть будет больно.
Тем не менее, передо мной задача стоит и решать её как-то надо.
Файл примера  (только один макрос и только шапка таблицы, которую собственно макрос заполняет, данными из файлов (прописан путь)) данный ресурс не принимает, поскольку видимо только текст макроса (там более нет ничего)  весит 971 КБ.
Готов выслать сам файл и при необходимости, пару файлов с данными, тому кто возьмётся за данную задачку.
Не хочу обидеть специалистов низкой суммой, но но так, навскидку скажу, что мне не жалко будет заплатить 1 000 руб. за реальную помощь в существенном ускорении работы макроса (с комментариями по тексту кода).
       
Новая тема "макрос для вывода постраничных итогов", В многостраничной таблице заполнить постраничные итоги
 
Добрый день
Странное поведение проявил макрос:
Исчезнувший на этапе тестирования недочёт вдруг появился опять, перед самым внедрением готового рабочего файла.

на 1 странице всего 62 строки.
Строка "Итого по странице"  идёт следующей строкой, но она не последняя на странице.
Следующая строка продолжает таблицу (за номером 63) на этой же странице.

Начиная со следующей страницы (и до 16 включительно),  к последней строке (после "Итого по странице) начинает прибавляться по одной строке, кратно числу страниц, а вставленная макросом строка с итогом соответственно смещается вверх.
То есть на пятой странице, под строкой "Итого по странице", ещё пять строк продолжения таблицы и так до 16 страницы включительно.
Интересно что после 16 страницы всё встало нормально (по строкам) и дальнейшая таблица нормально разбита постраничными итогами.
Вот код, подскажите пожалуйста что исправить:
Код
Sub постраничные_итоги()
    
    Application.ScreenUpdating = False 'False True
    ActiveWindow.View = xlPageBreakPreview
    Dim i&, hpb As HPageBreak, c1 As Range, c2 As Range
    Set c1 = [A3] ' >>> первая ячейка суммируемого столбца <<<
    For Each hpb In ActiveSheet.HPageBreaks
        Set c2 = Cells(hpb.Location.Row - 1, c1.Column)
        'c2.Select
        c2.EntireRow.Insert
         
        c2.Offset(-1, 2).Formula = "=""Итог по странице: Число порядковых номеров = ""&SUBTOTAL(3," & Range(c1, c2.Offset(-2, 0)).Address & ")& ""; Сумма фактического кол-ва штук = ""&SUBTOTAL(9," & Range(c1.Offset(0, 7), c2.Offset(-2, 7)).Address & ")"
        
        Set c1 = c2
    Next
    Set c1 = Cells(Rows.Count, c1.Column).End(xlUp)
    
    ActiveWindow.View = xlPageLayoutView
    ActiveWindow.View = xlNormalView
      
    ActiveWindow.SplitRow = 2
    ActiveWindow.FreezePanes = True
    
    Application.ScreenUpdating = True 'False True
    
    
End Sub

 
Новая тема "макрос для вывода постраничных итогов", В многостраничной таблице заполнить постраничные итоги
 
Цитата
написал:
Цитата
Решено "в первом приближении". Если кто-то хочет доделать, хоть и в платной ветке, то вэлкам, я не претендую.
Большое Вам Спасибо "МатросНаЗебре" !
На какой номер телефона и в какой сумме я могу выразить Вам мою признательность, благодарность и низкий поклон?
Новая тема "макрос для вывода постраничных итогов", В многостраничной таблице заполнить постраничные итоги
 
Я успешно нашёл причину смещения строк!
Ввиду того, что промежуточный итог заполнялся в столбец А, каждая новая " С2" прибавляла не до конца предыдущей таблицы, а до уже заполненной ранее ячейки "С2"
Переместив заполняемую ячейку из столбца А в другой столбец, проблема решилась.
С размещением и постраничным итогом вопрос полностью решился.
С форматированием строк ( по п. 3 исходного запроса) так ничего и не получилось пока, буду думать!
Новая тема "макрос для вывода постраничных итогов", В многостраничной таблице заполнить постраничные итоги
 
Ну с размещением формул и надписей я разобрался.
Всё получилось как надо
а вот с тем, что строка не последняя и смещается вверх с кажной страницей, пока не могу ничего сделать.
Подскажите пожалуйста.
Новая тема "макрос для вывода постраничных итогов", В многостраничной таблице заполнить постраничные итоги
 
Цитата
написал:
Цитата
написал:
поторопился  
Решено "в первом приближении". Если кто-то хочет доделать, хоть и в платной ветке, то вэлкам, я не претендую.
Ну претендентов не очень много )))
Вы сможете подкорректировать код, с учётом моих комментариев выше?
Новая тема "макрос для вывода постраничных итогов", В многостраничной таблице заполнить постраничные итоги
 
Цитата
написал:
МатросНаЗебре, поторопился  
Цитата
ну не всё так плохо.
Я отвечаю за свои слова и предложение в силе )))
а уж в каком разделе оно будет решено, это на размеры моей благодарности не влияет!
Новая тема "макрос для вывода постраничных итогов", В многостраничной таблице заполнить постраничные итоги
 
Спасибо огромное, что откликнулись!
Это уже многое.
По работе макроса:
запустил в массиве заполненных данных.
наблюдение №1:
на 1 странице  всего 53 строки.
Строка "Итого по странице"  идёт следующей строкой, но она не последняя на странице.
Следующая строка продолжает таблицу (за номером 54) и она является последней на этой странице.
Начиная со следующей страницы (и до 17 включительно),  к последней строке (после "Итого по странице) начинает прибавляться по одной строке, кратно числу страниц.
То есть на пятой странице, под строкой "Итого по странице", ещё пять строк продолжения таблицы и так до 17 страницы включительно. Интересно что после 17 страницы всё встало нормально (по строкам).

Наблюдение 2:
в ячейке по стоблцу "A" действительно становится сумма промежуточных итогов, которая охватывает диапазон от "-1 строка до "следующего итога".
Например на странице 17 она показывает 74 строки (из них 54 на своей странице и остальные на предыдущей странице, то строки Итого)
Но необходимо чтобы в крайней левой ячейке (как вариант по столбцу "B") было указано "Число порядковых номеров на странице:" а справа от этой записи уже эта формула, которая посчитает промежуточные итоги по столбцу "A".
С текстом который сейчас  пишется макросом как  "Итого по странице", я уже примерно понимаю как его сдвинуть вправо и полагаю что сам это сделаю.
Изменено: Konstanta - 31.03.2023 15:50:10 (опечатки)
Новая тема "макрос для вывода постраничных итогов", В многостраничной таблице заполнить постраничные итоги
 
Добавлю необходимые элементы "ТЗ"
1. После окончания формирования описи необходимо макросом внизу на каждой печатной странице  (под нижней строкой таблицы но сразу над колонититулом) вставить строку в которой:
слева на странице: "Число порядковых номеров на странице:"  и в соседней справа ячейке значение (счёт по столбцу A в пределах этой страницы)
Отформатировать по левому краю.
справа на странице: "Общий итог фактического кол-ва штук на странице:" и в соседней справа ячейке значение (сумма по столбцу H в пределах этой страницы).
Отформатировать по правому краю.
2. Всё это необходимо сделать на всех страницах, кроме самой последней страницы.
3.  На последней странице будет строка "итого". Я сам её сделаю и обработаю.
Необходимо отформатировать высоту всех строк (включая добавленные по п. 1) чтобы выше  последней строки на последней странице было как минимум три строки таблицы описи.

 
Новая тема "макрос для вывода постраничных итогов", В многостраничной таблице заполнить постраничные итоги
 
Уважаемые модераторы!
В связи с отсутствием интереса к данной теме, прошу перенести её в платный раздел сайта.
Надеюсь что там я смогу получить помощь.
Спасибо !
Новая тема "макрос для вывода постраничных итогов", В многостраничной таблице заполнить постраничные итоги
 
Вот файл примера
Новая тема "макрос для вывода постраничных итогов", В многостраничной таблице заполнить постраничные итоги
 
Приветствую всех Жителей Планеты!
На форуме есть закрытая тема "автоматичский вывод постраничных итогов" (вот она:https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=8&TID=25187&MID=220944#message220944)

Участник Казанский вывел превосходное решение, которое вполне удовлетворило автора темы и я рад за него.

Попытался я его применить к своему файлу с другой структурой, но ничего не вышло, а проблема остаётся.
Помогите пожалуйста, кто сможет:
В таблице на последней строке каждой печатной страницы необходимо указать Число порядковых номеров на странице (счёт по столбцу A)
и Общий итог фактического кол-ва штук на странице (сумма по столбцу H).
Я пытался менять код, но не получил нужного результата.
Прикладываю файл.
Спасибо всем кто откликнется.  
Найти разрыв страницы в указанном диапазоне
 
Добрый день!
В развитие темы вопрос:
данный макрос (судя по примеру) отлично справляется с итогом по концу страницы.

А как реализовать такай вариант:
В примере 44 строка таблицы является последней на листе.
После выполнения операции постраничного итога, вставить пустую строку между 44 и 45 и в данную строку записать итоги непосредственно в структуре таблицы, по графам этой таблицы, а не справа, как сейчас?


 
Объединение листов из разных книг в одну книгу
 
Ігор Гончаренко,  приветствую Вас!

Вот крайний Ваш код прям почти то, что мне нужно, но я не смог прикрутить к нему Ваше решение, которое Вы ранее подсказали мне в другой теме.
Мне надо в исходной папке все обработанные файлы удалить, и перенести их в папку "C:\test\Отработка" и как указать параметр "пропустить нужное число строк сверху листа" ?
Изменено: Konstanta - 16.02.2023 13:19:36 (уточнение вопроса)
Получить наименование активного приложения, При открытии файла получить наименование приложения, которое его открыло
 
Цитата
написал:
В Libre office макросы VBA не сработают
Ещё как работают. На либре несколько лет рабочие файлы, сделанные в Excel используем в 30-ти предприятиях.
Но Либре имеет значительно более скудный функционал приложения и не может соперничать с Excel.
И события также работают, в том числе на открытие.
И макросы там запущены.
И да, уважаемый bigorq, я знаю много людей, которые откроют xlsm файл в Либре, не отключая макросы, потому что просто привыкли запускать файлы данного типа в Либре, а у большинства из них вообще настроена ассоциация расширения xlsm на открытие Либре офисом.
Дело в том, что для применения в Либре я делал подобие обфускации VBA кода.
Но теперь рабочий файл будет работать в Excel и хочется обойтись стандартными для него методами.




 
Запуск макроса через пароль
 
Спасибо !
Всё получилось!
Запуск макроса через пароль
 
Добрый день
Но в этом окне пароль виден другому пользователю
как его закрыть звёздочками?
Получить наименование активного приложения, При открытии файла получить наименование приложения, которое его открыло
 
Приветствую всех жителей Планеты!
Разными путями многие пытаются зашифровать свои данные и макросы.
Но известно, что открыв файл xlsm в Либре офисе, там в редакторе всё видно и никакие простые защиты тут не помогут.
Отсюда появилась мысль:
А что если макрос при открытии сможет получить наименование приложения и тем самым запустить удаление закрытых данных, если приложение не равно предназначенному MS Excel?

Вопрос только в одном:
Как получить наименование активного приложения, в котором открыт файл?
Не показывать содержимое книги если макросы отключены
 
Цитата
написал:
Опять же, это только для "бабушек из бухгалтерии", и много раз разбиралось на форуме. Если пользователь захочет вскрыть ваш документ то он его вскроет элементарно даже либрой или опен
Приветствую всех жителей Планеты!
вот как раз по этой теме вопрос:
Файл, где все макросы защищены паролем, листы, действия и прочее также защищены.
Но достаточно открыть файл в Либре и зайти в редактирование макросов, там всё как на ладони...
Неужели нет никакой возможности защиты от этого?
Пусть сам файл откроется и листы станут беззащитными
Но как защищённое содержимое проекта VBA не пустить в Либре?  
Зашифровать с использованием пароля из VBA
 
Всё получилось!
Спасибо !
Решено!
Зашифровать с использованием пароля из VBA
 
Цитата
написал:
Вон же строчка в макросе выше )))
Цитата
Все_просто написал:
Workbooks.Open filename:=filename, password:=password
Так, да не совсем так:
1. Имена у файлов заведомо неизвестны (их ручками формируют пользователи, кто во что горазд), именно поэтому мы берём все (!) файлы из папки и нет возможности прописать имя файла.
2. Допускаю что я впишу в код password:=password (известный пароль).
но куда мне тогда вписать "password" ?
куда ни пробую, везде  ошибка компиляции выходит
 
Зашифровать с использованием пароля из VBA
 
Жители "планеты" приветствую Вас!
Время идёт, жизнь ставит новые задачи!
В развитие темы появилась новая проблема:
При открытии из макроса одного файла (с известным путём и именем) но защищённого известным паролем на открытие, открыть этот файл макросом не составляет труда по методу, описанному здесь.

У меня есть конкретная папка с известным путём и в ней лежат файлы с паролем на открытие (пароль известен и на всех файлах идентичен).
До установки пароля все файлы без проблем открывались макросом:
Код
Sub Открыть()
Dim s As String, fldr As String
fldr = "c:\Ведомости\"
s = Dir(fldr & "*.xlsx")
Do While s <> ""
    With Workbooks.Open(fldr & s)
        'действия с книгой
'        .Close
    
    End With
    s = Dir
Loop
End Sub
Теперь файлы закрыты паром открытия.
Подскажите пожалуйста: куда и как мне прописать пароль в данный код?
Спасибо !
Автоматический запуск макроса при изменении данных
 
Спасибо!
Решено!
Автоматический запуск макроса при изменении данных
 
Приветствую Всех!
Всё классно, но появилась новая вариация исходной задачи:
Есть стандартный код при изменении диапазона данных.
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Range("J8:K30"), Range(Target.Address)) Is Nothing Then
      MsgBox "Значение ячейки " & Target.Address & " изменено."
    End If
End Sub
Но мне необходимо чтобы данный макрос срабатывал только при изменении пользователем.
Если же на листе изменения создаёт макрос, то данный код не должен запускаться.
Есть варианты доработки?
Спасибо !
Изменено: Konstanta - 26.01.2023 15:32:13 (Исправил опечатки)
Список файлов в папке через макрос
 
Всё работает отлично!!!
Спасибо огромное!!!
Список файлов в папке через макрос
 
Да вот что-то не выходит у меня...
Ругается, причём в окно выводит список тех файлов, которые на самом деле лежат в папке.
Даже при полном наличии всех файлов не хочет пропускать запуск макроса
Список файлов в папке через макрос
 
Цитата
написал:
запишите где-то в начале процедуры
Код
    [URL=#]?[/URL]       1  2  3  4  5  6          Dim   fs, f, nof$        fs = Array(  "f1"  ,   "f2"  ,   "f3"  )        For   Each   f   In   fs          If   Dir(f) =   ""   Then   nof = nof & vbLf & f        Next        If   Len(nof)   Then   MsgBox nof, vbCritical,   "Не найдено!!!"  :   Exit   Sub   
 
Под "f1" понимается полное имя каждого файла, включая путь и его расширение?
Страницы: 1 2 След.
Наверх