Страницы: 1
RSS
В каждой книге из папки, в зависимости от названия листа, запустить определенный макрос, vba
 
Здравствуйте!
Есть папка с книгами. В книге несколько листов. Название каждого листа начинается или с "яблоки", или с "Слива", или с "Вишня" . И есть три макроса, каждый из которых предназначен для определенного листа. Вернее для листа с определенным текстом в начале имени листа.
Прошу помочь макросом, который на каждом листе в каждой книге папки запустить соответствующий макрос .
Код
Sub Макрос_A()
'Если название листа начинается с "яблоки",
'то запускаем этот макрос
Range("A1").Select
    With Selection.Interior
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.399975585192419
    End With
End Sub
Sub Макрос_B()
'Если название листа начинается с "Слива",
'то запускаем этот макрос
Range("A1").Select
    With Selection.Interior
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.399975585192419
    End With
End Sub
Sub Макрос_C()
'Если название листа начинается с "Вишня",
'то запускаем этот макрос
Range("A1").Select
    With Selection.Interior
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.399975585192419
    End With
End Sub
 
Вы не пояснили когда надо запускать эти макросы
 
Код
Sub SetWorksheetsA1Theme(wb As Workbook)
  Dim ws As Worksheet, sh$, dnms
  Set dnms = DThemeColor
  For Each ws In wb.Worksheets
    sh = Left(ws.Name, 5)
    If dnms.exists(sh) Then
    With ws.[a1].Interior
      .ThemeColor = dnms(sh)
      .TintAndShade = 0.399975585192419
    End If
  Next
End Sub

Function DThemeColor()
  Set DThemeColor = CreateObject("Scripting.Dictionary")
  DThemeColor("яблок") = xlThemeColorAccent2
  DThemeColor("Слива") = xlThemeColorAccent3
  DThemeColor("Вишня") = xlThemeColorAccent4
End Function
Изменено: Ігор Гончаренко - 24.02.2021 20:35:48
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
Евгений Смирнов написал:
когда надо запускать эти макросы
Думаю, так:
1) открыть первую книгу,
2) затем, наверное, надо активировать поочередно каждый лист,
3) определить каким текстом начинается имя листа,
4) выполнить соответствующий макрос,
5) активировать следующий лист,
6) определить имя..
Закончились листы первой книги - открыть вторую книгу..
 
упростите алгоритм до такого:
1. Открыть книгу
2. выполнить макрос SetWorksheetsA1Theme, передав ему параметром открытую книгу
3. сохранить книгу
4. повторить пп.1,2,3 со для каждой книги в папке
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко,
Мне точно не подходит. Понятно что три макроса чисто для примера.
Можно еще условие добавить: вызывать макрос примитивно, то есть
Код
Call Макрос_A
или
Call Макрос_B
Изменено: Михаил Л - 24.02.2021 20:52:17
 
Цитата
Ігор Гончаренко написал:
выполнить макрос SetWorksheetsA1Theme
А вообще как такой макрос выполнить?
Его не видно
 
Код
Sub Test
  SetWorksheetsA1Theme avtiveworkbook
end sub

макрос Test выполнит макрос SetWorksheetsA1Theme
текст макроса  SetWorksheetsA1Theme приведен в сообщении #3
скопируйте макросы из #3 в стандартный модуль вашего проекта. пользуйтесь
Цитата
Понятно что три макроса чисто для примера
понятно, что решение чисто по примеру
задача у вас вообще какая?
запустить макрос
или
применить к ячейке А1 листа заливку в зависимости от названия этого листа?
какая у вас задача??
Изменено: Ігор Гончаренко - 24.02.2021 20:56:53
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
Ігор Гончаренко написал:
применить к ячейке А1 листа заливку в зависимости от названия этого листа?
Заливки не будет вообще :D  Придумал заливку только для примера.
Задача запускать нужный макрос макросом, который перед запуском проверяет имя листа.
И вариант вручную открывать книгу не очень подходит.
 
Цитата
Михаил Л написал:
вариант вручную открывать книгу не очень подходит.
открывайте как вам удобно, где у меня написано "вручную"
Код
select case left(ws.name, 5)
  case "яблок": Макрос_А
  case "Слива": Макрос_В
  case "Вишня": Макрос_С
select end
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, спасибо!
Попробую завтра прикрутить
 
как вариант

Код
Sub Test()
    Dim iPath As String, FD As FileDialog, MyFile As String, TempWB As Workbook, Sht As Worksheet
    
    'выбор папки
    Set FD = Application.FileDialog(msoFileDialogFolderPicker)
    With FD
        .AllowMultiSelect = False
        .Title = "Укажите папку с файлами"
        .ButtonName = "Выбрать папку"
        If .Show = False Then Exit Sub Else iPath = .SelectedItems(1) & Application.PathSeparator
    End With
    Set FD = Nothing
    
    MyFile = Dir(iPath & "*.xlsx")
    Do While MyFile <> ""
        If MyFile <> ThisWorkbook.FullName Then
            'Открываем файлы один за другим
            Set TempWB = Workbooks.Open(iPath & MyFile)
            'цикл по всем листам в файле
            For Each Sht In TempWB.Worksheets
                If InStr(1, Sht.Name, "яблоки", vbTextCompare) > 0 Then Call Макрос_A (Sht)
                If InStr(1, Sht.Name, "Слива", vbTextCompare) > 0 Then Call Макрос_B (Sht)
                If InStr(1, Sht.Name, "Вишня", vbTextCompare) > 0 Then Call Макрос_C (Sht)
            Next Sht
            'сохраняем и закрываем файл в папке
            TempWB.Close SaveChanges:=True
            'Следующий файл в папке
            MyFile = Dir
        End If
    Loop
    MsgBox "Конец", vbInformation, "Конец"
End Sub

Sub Макрос_A(sht as WorkSheet)
   With sht
        'код макроса (не забываем перед написанием диапазонов ставить ".", что бы работа производилась на переданном листе)
   End With
End Sub

Sub Макрос_B(sht as WorkSheet)
   With sht
        'код макроса (не забываем перед написанием диапазонов ставить ".", что бы работа производилась на переданном листе)
   End With
End Sub

Sub Макрос_C(sht as WorkSheet)
   With sht
        'код макроса (не забываем перед написанием диапазонов ставить ".", что бы работа производилась на переданном листе)
   End With
End Sub
Изменено: New - 25.02.2021 18:08:47
 
New, спасибо! Сегодня опробую
 
New, в этой части
Код
                If InStr(1, Sht.Name, "яблоки", vbTextCompare) > 0 Then Call Макрос_A
                If InStr(1, Sht.Name, "Слива", vbTextCompare) > 0 Then Call Макрос_B
                If InStr(1, Sht.Name, "Вишня", vbTextCompare) > 0 Then Call Макрос_C

я бы передавал сам лист в запускаемый макрос иначе все будет происходить на активном листе.
как то так
Код
                If InStr(1, Sht.Name, "яблоки", vbTextCompare) > 0 Then Call Макрос_A (Sht)
                If InStr(1, Sht.Name, "Слива", vbTextCompare) > 0 Then Call Макрос_B (Sht)
                If InStr(1, Sht.Name, "Вишня", vbTextCompare) > 0 Then Call Макрос_C (Sht)

В макросах же Макрос_A,Макрос_B,Макрос_C, так же нужно прописать получение параметром листа, и работать с полученным листом,
а не с активным.
Примерно так:
Код
Sub Макрос_A(sht as WorkSheet)
   With sht
      .....код макроса (не забываем перед написанием диапазонов ставить ".", что бы работа производилась на переданном листе)
   End With
End Sub
"Все гениальное просто, а все простое гениально!!!"
 
Да, согласен
 
Вообщем получилось окрасить только один лист из книги.
Наугад пытался:
Код
Sub Макрос_A(sht As Worksheet)
   With sht
'Если название листа начинается с "яблоки",
'то запускаем этот макрос
.Range("A1").Select
    .With Selection.Interior
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.399975585192419
    .End With
    End With
    
End Sub

но .End With выделяется красным.
Я в принципе решил проблему - показал девочке как вручную делать. По моему, в полчаса времени укладывается.
Название темы бы поправить - ..зависимости от названия листа, запустить...
Изменено: Михаил Л - 25.02.2021 17:47:38
 
точки перед With and End With не нужны. Точки нужны только перед свойствами и объектами.
От Select  тоже желательно избавиться

Код
Sub Макрос_A(sht As Worksheet)
'Если название листа начинается с "яблоки", то запускаем этот макрос
    With sht       
        With .Range("A1").Interior
            .ThemeColor = xlThemeColorAccent2
            .TintAndShade = 0.399975585192419
        End With
    End With
End Sub
Изменено: New - 25.02.2021 18:07:09
 
New, так работает. Спасибо
Только мне не подходит. мне бы вместо этого:
Код
        With .Range("A1").Interior
            .ThemeColor = xlThemeColorAccent2
            .TintAndShade = 0.399975585192419
        End With

вызывать макрос
Код
Call Макрос_A
В принципе не надо ничего. Я уже от этой проблемы отвязался
 
так это и есть код Макрос_A
один код  открывает файлы из папки и ищет нужные листы и вызывает Макрос_А, а Макрос_А уже делает что-то на листе.
Изменено: New - 25.02.2021 19:16:12
 
так и пишите
Код
'        With .Range("A1").Interior
'            .ThemeColor = xlThemeColorAccent2
'            .TintAndShade = 0.399975585192419
'        End With
        Макрос_A
поздравляю! теперь вместо всей той ерунды сработает макрос А
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Игорь, тогда рекурсия выйдет. Из кода Макрос_А, вызывать Макрос_А
 
Цитата
New написал:
рекурсия выйдет. Из кода Макрос_А, вызывать Макрос_А
Я имел ввиду, вызывать макросы из первого сообщения. Будет семь макросов
 
такое впечатление, что тут кто-то знает, что нужно автору?
может как раз рекурсии он и добивался, чтобы задро задрать компьютер на фиг! а то достали эти компьютеры слишком много начали себе позволять
чтобы всякий искусственный интеллект понял, что он ноль в руках бестолкового пользователя

и еще
главное - безудержно насыпать в тему код - рано или поздно кто-то угадает)
я с вас угораю
вы смотрите в текст макрос_А и пытаетесь как-то это реализовать
а еще в #9 автор мне написал:
Цитата
Заливки не будет вообще  Придумал заливку только для примера.
понимаете? только для примера, над чем паритесь, господа?
самая правильная реакция для бестолковой темы - это склоненные головы и траурное молчание
или альтернативный вариант:
безудержный шабаш кода, когда-то, кто-то, угадает))) (об этом нам говорит теория вероятности, шанс мизерный, но есть!)
Изменено: Ігор Гончаренко - 25.02.2021 19:37:00
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
Ігор Гончаренко написал:
реакция для бестолковой темы
Кто как видит - пусть так и смотрит на эту тему.
Мне же надо на листе с одним названием проиграть один макрос, на листе с другим названием - другой макрос. Вот и все. Заливки не  будет - будет макрорекордерный код, слегка подправленый руками. Эти коды уже готовы. А вот циклом или вообще пробегаться по книгам и листам - это уже непосильно мне
 
а тут никому не по силам угадать что будет в вашем коде
а вся тема балаган.
читаем заголовок:
Цитата
Михаил Л написал:
В каждой книге из папки, в зависимости от названия книги, запустить определенный макрос
читаем сообщение 24:
Цитата
Михаил Л написал:
Мне же надо на листе с одним названием проиграть один макрос, на листе с другим названием - другой макрос
так что же ж вам надо? в зависимости от названия книги или листа?
читаеам 10 (в зависимости от названия листа)
Цитата
Ігор Гончаренко написал:
select case left(ws.name, 5)  
 case "яблок": Макрос_А  
 case "Слива": Макрос_В  
 case "Вишня": Макрос_С
select end
что вам еще?
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко в сообщении №10 показал, как запускать разные макросы с разных листов.
Вы в сообщении №16 что применили?
Цитата
Михаил Л написал: Наугад пытался
А надо не наугад, а вникать в предложенное, пробовать разобраться.
Где предложенный Select Case?

Цитата
Михаил Л написал: 1) открыть первую книгу, 2) затем, наверное, надо активировать поочередно каждый лист, 3) определить каким текстом начинается имя листа, 4) выполнить соответствующий макрос,
Извините, но это - комплекс вопросов. А тема о том, как запустить разные макросы из разных листов. Решение Вам дали.
Хотите готовенькое, комплексно - раздел Работа.
 
Цитата
vikttur написал:
Где предложенный Select Case?
Вот мои пробы
 
Так работает
Код
Sub Макрос2()
    Dim sFolder As String, sFiles As String, wb As Workbook
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    Application.DisplayAlerts = False
    sFiles = Dir(sFolder & "*.xlsx")
    Do While sFiles <> ""
        Set wb = Workbooks.Open(sFolder & sFiles)
        wb.Activate
     
      Dim x As Worksheet
      For Each x In wb.Worksheets
      x.Activate
      a = Left(x.Name, 5)
      If a = "яблок" Then
      Макрос_A
      ElseIf a = "Слива" Then
      Макрос_B
      ElseIf a = "Вишня" Then
      Макрос_C

      End If
      
      Next x
      
        wb.Save
        wb.Close False
        sFiles = Dir
    Loop
    Application.DisplayAlerts = True
End Sub
Страницы: 1
Наверх