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

Страницы: 1
Копирование формулы vba excel, Произвести вычисления в ячейке
 
Код
ThisWorkbook.ActiveSheet.Range("A126:B129").Copy
        ActiveWorkbook.Sheets("затраты").Range("H107:I110").PasteSpecial Paste:=xlPasteFormulas
Прошу помочь.
Имеется фрагмент кода, который копирует формулу из одного файла в другой. Почему скопированные ячейки не производят вычисления? Чтобы формула произвела расчет приходится проваливаться в ячейку и нажимать enter.
Вывод ошибок с названиями файлов в текущую книгу (VBA)
 
Имеется макрос, который разрывает связи в файлах excel. Подскажите как мне вывести в текущую книгу названия файлов, у которых связи не разрываются или есть какие  то ошибки.
Код
Sub Убрать связи()
On Error Resume Next
    Dim sFolder As String, sFiles As String
    Dim wb As Workbook
    Dim WbLinks As Variant, i As Long
        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.ScreenUpdating = False
    Application.AskToUpdateLinks = False
    sFiles = Dir(sFolder & "*.xls*")
Do While sFiles <> ""
            Set wb = Application.Workbooks.Open(sFolder & sFiles, 0)
            WbLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
            If Not IsEmpty(WbLinks) Then
                For i = 1 To UBound(WbLinks)
                ActiveWorkbook.BreakLink Name:=WbLinks(i), Type:=xlExcelLinks
                Next i
            End If
            wb.Close True
            sFiles = Dir
   Loop
   Application.ScreenUpdating = True
 End Sub
Оптимизация кода форматирования не защищенных ячеек., Сократить время выполнения макроса
 
Помогите ускорить процесс выполнения кода. Код выполняет следующие действия: проверяет защищена ячейка или нет. Если нет, то форматирует ее и переходит к следующей.
Код
 Range("A110:DY300").Select
               For Each rCell In Selection
               If rCell.Locked = False Then
                  rCell.Select
                  Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
               End If
               Next rCell
Изменено: БМВ - 10.07.2023 15:22:10
Поменять формат ячеек (обойти ячейки с защитой) в списке файлов
 
1. Отправляю код, который копирует формат ячейки B12 в ячейки A110:DD2000. В указанном диапазоне A110:DD2000 иногда есть защищенные ячейки. Находится могут в любом месте. Как обойти эти защищенные ячейки (или даже лучше снять защиту) и поменять формат в остальных

2. Как сделать так, чтобы при открытии диалогового окна можно было выбрать не все файлы из папки, а видно было список файлов для выбора.

Код
Sub Поменять_форматы()
   Dim sFolder As String, sFiles As String
   Dim 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.ScreenUpdating = False
   Application.AskToUpdateLinks = False
   sFiles = Dir(sFolder & "*.xls*")
   Range("B12").Select
   Selection.Copy
   Do While sFiles <> ""
              Set wb = Application.Workbooks.Open(sFolder & sFiles, 0)
             
              wb.Sheets("Лист").Activate
              Range("A110:DD2000").Select
              Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
         
              wb.Close True
              sFiles = Dir
   Loop
   Application.ScreenUpdating = True
   Application.CutCopyMode = False
   MsgBox "Форматы изменены"
End Sub
Скрыть листы макросом, С помощью макроса скрыть определенные листы
 
В файле есть листы с определенными названиями. Среди них есть лишние вспомогательные листы, которые скрываются. Проблема в том, что часть листов заключенная между листами 5 и 8 необходима для отображения. Их названия могут быть произвольными и разное количество. Результат работы макроса не дает должный результат. Поправьте пожалуйста






Sub Скрыть_листы()
   Dim sFolder As String, sFiles As String
   Dim wb As Workbook
   Dim sh As Worksheet
   Dim i
       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.ScreenUpdating = False
   Application.AskToUpdateLinks = False
   sFiles = Dir(sFolder & "*.xls*")
       Do While sFiles <> ""
           Set wb = Application.Workbooks.Open(sFolder & sFiles, 0)
           For Each sh In Worksheets
             Select Case sh.Name
                    Case Is = "лист1", "лист2", "лист5", "лист8"
                    sh.Visible = True
                    Case Else
                    sh.Visible = False
            End Select
           For i = wb.Worksheets("лист5").Index + 1 To wb.Worksheets("лист8").Index - 1 Step 1
               p = i - wb.Worksheets("лист5").Index
               Worksheets(p + 1).Visible = True
           Next
           Next
           wb.Close True
           sFiles = Dir
       Loop
   Application.ScreenUpdating = True
   MsgBox "Листы скрыты"
 End Sub
Страницы: 1
Наверх