How do I automate macros to be placed in many workbooks that won't be on my PC

[K0st4din]

Hello everyone,
I have read many things on the internet, but I could not find a solution to my problem. I don't know if there will ever be a macro that can solve my problem. In one workbook I have 28 worksheets. then with a macro I separate 14 workbooks with 2 worksheets in each workbook. I have 2 macros in vba, the 1st is in Thisworkbook, the 2nd is in Module. This is where my problem starts: I transfer these two macros in all 14 workbooks with copy/paste, which totally kills me. Because these macros make it so that they put restrictions on copying, printing, etc., and the 2nd one after certain days totally deletes the workbook. So, if it's just for my excel, I read how to do things, like what file to always have the macros, but in this case, as you can see, it's about 14 workbooks that must have these restrictions, so that different users cannot do anything with the files. I read that there was a way to make a macro or something that was sent to every single user and when they installed it, the macros were implemented in their excels. But that's not a solution because firstly they won't be able to handle it and secondly there's no way I can be sure they will. So my dilemma remains - how can I as quickly as possible put these macros into each workbook and then be able to send the files to the specific people. I hope I have explained well what I am trying to automate. Of course I remain available if I need to explain anything further. And I'm really hoping for some help because I'm desperate to copy and paste every month. Thanks in advance!

 

[Edgar_]

That helps to know what you do, but I still don't know how you're doing it. What happens if you just use something like this
1. Insert a module
2. Add this code

Sub sample()
    Sheets("blagoev").SaveAs ThisWorkbook.Path & "\blagoev", 52
    Sheets("blagoev total").SaveAs ThisWorkbook.Path & "\blagoev total", 52
End Sub

3. Run it
4. Check the same location where your workbook is, there should be two files there
5. Open them
6. Check if they have the code you need included

 

[K0st4din]

One second, one second, I can't upload the file, but I can upload the macro that is in UserForm1

P.S. If I understand correctly with your last macro - to save the file, that means at least 14 button presses to be able to save all the individual workbooks - which again takes me back many clicks.

Option Explicit
Dim rhojas
Dim cargando
Dim setsh As Worksheet

Private Sub CheckBox3_Click()

End Sub

Private Sub CheckBox7_Click()
  Dim i As Long
  For i = 0 To ListBox1.ListCount - 1
    ListBox1.Selected(i) = CheckBox7
  Next
End Sub

Private Sub CommandButton1_Click()
'Por.Dante Amor
    Dim Pdfhojas()
    Dim HojasOcultas()
    Dim hojaactiva As String
    Dim n As Double, m As Double, i As Double, ni As Long
    Dim wvis As Variant, h As Variant
    Dim ruta As String, namePdf As String, nameSh As String
    Dim sh2 As Worksheet
    Dim wname As Name
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    '
    hojaactiva = ActiveSheet.Name
    n = -1
    m = -1
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) Then
            h = ListBox1.List(i)
            n = n + 1
            ReDim Preserve Pdfhojas(n)
            Pdfhojas(n) = h
            wvis = Sheets(h).Visible
            If wvis <> -1 Then
                m = m + 1
                ReDim Preserve HojasOcultas(m)
                HojasOcultas(m) = h
                Sheets(h).Visible = -1
            End If
        End If
    Next
    
    ruta = TextBox1.Value
    
    If n > -1 Then
            
        '
        'Save as PDF
        If CheckBox1.Value = True Then
            If CheckBox6.Value = False Then
                Sheets(Pdfhojas).Select
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                    Filename:=ruta & Label2.Caption, _
                    Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                    IgnorePrintAreas:=False, OpenAfterPublish:=False
            Else
                For ni = 0 To UBound(Pdfhojas)
                    
                    nameSh = CStr(Pdfhojas(ni))
                    namePdf = TextBox2.Value & Sheets(nameSh).Range(TextBox3.Value).Value & TextBox4.Value & ".pdf"
                    Sheets(nameSh).ExportAsFixedFormat Type:=xlTypePDF, _
                        Filename:=ruta & namePdf, _
                        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                        IgnorePrintAreas:=False, OpenAfterPublish:=False
                
                Next
            End If
        End If
        '
        'Print
        If CheckBox2.Value = True Then
            Sheets(Pdfhojas).PrintOut
        End If
        '
        'Save as xlsx
        Application.CopyObjectsWithCells = False
        If CheckBox3.Value = True Then
            Application.EnableEvents = False
            Sheets(Pdfhojas).Copy
            ActiveWorkbook.SaveAs _
                Filename:=ruta & Label3.Caption, _
                FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False ' xlOpenXMLWorkbookMacroEnabled, xlExcel12
                
            'Only values and formats
            If CheckBox4.Value = True Then
                For Each sh2 In ActiveWorkbook.Sheets
                    sh2.Cells.Copy
                    sh2.Range("A1").PasteSpecial xlPasteValues
                    sh2.Range("A1").PasteSpecial xlPasteFormats
                Next
            End If
            
            'remove named ranges
            If CheckBox5.Value = True Then
                'On Error Resume Next
                For Each wname In ActiveWorkbook.Names
                    ActiveWorkbook.Names(wname.Name).Delete
                Next
                'On Error GoTo 0
            End If
            
            ActiveWorkbook.Close True
            Application.EnableEvents = True
        End If
        Application.CopyObjectsWithCells = True
        '
        'Guarda archivo como Binario
        'Sheets(hojas).Copy
        'ActiveWorkbook.SaveAs _
            Filename:=ruta & arch, _
            FileFormat:=xlExcel12, CreateBackup:=False
        'ActiveWorkbook.Close False
        '
        'Oculta nuevamente las hojas
        If m > -1 Then
            Sheets(HojasOcultas).Visible = 0
        End If
    End If
    Sheets(hojaactiva).Select
    MsgBox "Finish", vbInformation
End Sub

Private Sub CommandButton2_Click()

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select Folder"
        .AllowMultiSelect = False
        .InitialFileName = ThisWorkbook.Path
        If .Show <> -1 Then
            TextBox1.Value = ThisWorkbook.Path & "\"
        Else
            TextBox1.Value = .SelectedItems(1) & "\"
        End If
    End With

End Sub

Private Sub CommandButton3_Click()
  Unload Me
End Sub
'
Private Sub ListBox1_Change()
'Por.Dante Amor
    Dim i As Double, j As Variant
    
    If cargando Then Exit Sub
    cargando = True
    For i = 0 To ListBox1.ListCount - 1
        For Each j In rhojas
            If LCase(ListBox1.List(i)) = LCase(j.Value) Then
                ListBox1.Selected(i) = True
                Exit For
            End If
        Next
    Next
    cargando = False
End Sub

Private Sub TextBox1_Enter()
    CommandButton2_Click
End Sub

'
Private Sub UserForm_Activate()
'Por.Dante Amor
    Dim rnever As Range, rrango As Range
    Dim uc As Double, j As Variant, ini As Double, fin As Double, k As Double
    Dim xnum As Variant
    Dim existe As Boolean
    Dim h As Worksheet
    Dim arch As String, archPdf As String, archExcel As String
    
    Set setsh = Sheets("set")
    
    Set rhojas = setsh.Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row)
    Set rnever = setsh.Range("B3:B" & Range("B" & Rows.Count).End(xlUp).Row)
    
    TextBox1.Value = ThisWorkbook.Path & "\"
    uc = setsh.Range("C" & Rows.Count).End(xlUp).Row
    If uc > 2 Then Set rrango = setsh.Range("C3:C" & uc)
    '
    cargando = True
    
    arch = "several sheets"
    If setsh.Range("D3").Value = "" Then
        archPdf = arch
    Else
        archPdf = setsh.Range("D3").Value
    End If
    If setsh.Range("E3").Value = "" Then
        archExcel = arch
    Else
        archExcel = setsh.Range("E3").Value
    End If
    
    Label2.Caption = Replace(setsh.Range("D3") & ".pdf", "/", "-")
    Label3.Caption = Replace(setsh.Range("E3") & ".xlsm", "/", "-")
    
    ListBox1.MultiSelect = 1
    ListBox1.ListStyle = 1
    For Each h In Sheets
        'sheets never select
        existe = False
        For Each j In rnever
            If LCase(h.Name) Like LCase(j.Value) Then
                existe = True
                Exit For
            End If
        Next
        If existe = False Then
            ListBox1.AddItem h.Name
        End If
        '
        'sheets always select
        For Each j In rhojas
            If LCase(h.Name) = LCase(j.Value) Then
                ListBox1.Selected(ListBox1.ListCount - 1) = True
                Exit For
            End If
        Next
        '
        'sheets select
        If uc > 2 Then
            For Each j In rrango
                xnum = Split(j.Value, "-")
                ini = Val(xnum(0))
                fin = Val(xnum(UBound(xnum)))
                For k = ini To fin
                    If h.Index = k Then
                        ListBox1.Selected(ListBox1.ListCount - 1) = True
                        Exit For
                    End If
                Next
            Next
        End If
    Next
    cargando = False
End Sub

 

[K0st4din]

Just adding - I tried the macro but it doesn't.
Because blagoev and blagoev total - should be in one workbook with these two worksheets. In my case it makes two separate files.
Otherwise, Yes, it also takes the macros that are inside, but what is copied, even in one file, also takes all the other worksheets, which is not OK (it goes without saying, somehow separating them).
And the other thing that strikes me is that there are macros that I don't need to copy (which will mean that I only need to say to move for example: Module2 and Module4 and ThisWorkbook (the macros that are inside)

 

[Edgar_]

It seems you have a lot of moving pieces, I think the best approach here is to just do that in another step. Once you have all your exported workbooks, put them all in the same folder and a routine can take care of including the necessary modules.

That involves the file system object, a for loop and trusting the code project, but it would allow me to not touch the rest of the code. I'll come up with something tomorrow.

 

[K0st4din]

And it's a good idea, as you say.
Extract what I need in the individual files, then add the finishing touches with another macro for all the already split workbooks. In this way, we will have a division that, if something becomes necessary, can be more easily modified.
Thank you very much!
See you tomorrow!

 

[Edgar_]

Add a reference to Microsoft Scripting Runtime and adapt this code:

Option Explicit

Private fso As Scripting.FileSystemObject

Public Function GetAFolder(filePath As String) As Scripting.folder
    Set fso = New Scripting.FileSystemObject

    Dim someFolder As Scripting.folder
    Set someFolder = fso.GetFolder(filePath)
   
    Set GetAFolder = someFolder
End Function

Sub ProcessFiles()

    Set fso = New Scripting.FileSystemObject
   
    'access folder
    Dim folder As Scripting.folder
    Set folder = GetAFolder("C:\path\to\your\folder")
   
    'export module to import later
    ThisWorkbook.VBProject.VBComponents("someModule").Export ThisWorkbook.Path & "\someModule.bas"
   
    'declare some vars
    Dim wb As Workbook
    Dim file As Scripting.file
    Dim fileExt As String
    Dim ws As Worksheet
    Dim codeString As String
   
    'loop folder
    For Each file In folder.Files
        'ignore non excel files
        If fso.GetExtensionName(file.Path) = "xlsx" Or fso.GetExtensionName(file.Path) = "xlsm" Then
            'open wb from file
            Set wb = Workbooks.Open(file.Path, False, False)
           
            'import module
            wb.VBProject.VBComponents.Import ThisWorkbook.Path & "\someModule.bas"
           
            'write code to all worksheet modules
            For Each ws In wb.Worksheets
                'get the code
                With ThisWorkbook.VBProject.VBComponents("sheetNameWhereYouHaveSheetCode").CodeModule
                    codeString = .Lines(2, .CountOfLines)
                End With
               
                'write the code
                wb.VBProject.VBComponents(ws.CodeName).CodeModule.AddFromString codeString
            Next ws
           
            'get code from thisworkbook
            With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
                codeString = .Lines(2, .CountOfLines)
            End With
           
            'write code to the thisworkbook module of target file
            wb.VBProject.VBComponents("ThisWorkbook").CodeModule.AddFromString codeString
           
            'save and close
            wb.SaveAs ThisWorkbook.Path & "\" & Left(wb.Name, Len(wb.Name) - 4) & "xlsm", 52
            wb.Close True
        End If
    Next file
End Sub

Put that code in the parent file. Assuming your parent file has code in a worksheet, ThisWorkbook and a module, this should let you import it. Just configure the folder, the output files will be saved in the same path of your parent file.

This can be further improved in many ways, but I just quickly put it together.

 

[K0st4din]

Hello,
you mean to keep them like this, this way.
Are we continuing with the idea that I have taken out all 14 workbooks ....?

 

[Edgar_]

Hello,
you mean to keep them like this, this way.
Are we continuing with the idea that I have taken out all 14 workbooks ....?
View attachment 108459

Once you have exported all your workbooks and they're ready to receive modules and code, put them in a folder, regardless of how many you have. Use that folder path in this line:
Set folder = GetAFolder("C:\path\to\your\folder")
You said you had a module that you were adding to all your files. Write the name of the module in this line, keep the .bas extension.
ThisWorkbook.VBProject.VBComponents("someModule").Export ThisWorkbook.Path & "\someModule.bas"

You said you were writing sheet code to the worksheets of the exported file. Write the name of the worksheet that has that code in the parent file in this line:
With ThisWorkbook.VBProject.VBComponents("sheetNameWhereYouHaveSheetCode").CodeModule

You said you had code in your ThisWorkbook module that you were copying to the exported files. The procedure will take care of that.

Test it and let me know what happens.

 

[K0st4din]

I don't think I understand it.
Just so there's no confusion, here's what I did.
I made a brand new excel file. In it I put the 2 modules and the macro in ThisWorkbook, I also put your macro (in which I put the path where the 14 files are located and the name of the new file in which the necessary macros are located) - is this how I should do it, because in the main workbook i have a few more modules with macros and i'm worried that it will copy everything, even the unnecessary ones?
However, when I'm already at the finish, I make a button to attach and activate your macro, but I get 2 options and I don't know which one to activate.

in ThisWorkbook
' Code of ThisWorkbook module

Option Explicit

Private Sub Workbook_BeforePrint(Cancel As Boolean)
   MsgBox "Please print via [Print] or [Pdf] button"
  Cancel = True
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  MsgBox "Please save via [Save] button"
  Cancel = SaveAsUI
End Sub

Sub SaveButton()
  Application.EnableEvents = False
  Me.SaveAs Me.Name, FileFormat:=xlOpenXMLWorkbookMacroEnabled
  Application.EnableEvents = True
End Sub

Sub PrintButton()
  Application.EnableEvents = False
  Me.PrintOut
  Application.EnableEvents = True
End Sub

Sub PdfButton()
  Dim PdfFile As String, char
  Application.EnableEvents = False
  ' Build PdfFile's name
  PdfFile = Me.Name & "_" & Format(Date, "yymmdd_hhmmss")
  ' Replace unallowed symbols by the underscore char
  For Each char In Split("? "" / \ < > * | :")
    PdfFile = Replace(PdfFile, char, "_")
  Next
  ' Add path of this workbook
  PdfFile = Left(Me.Path & "\" & PdfFile, 251) & ".pdf"
  ' Create Pdf
  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                         Filename:=PdfFile, _
                         Quality:=xlQualityStandard, _
                         IncludeDocProperties:=True, _
                         IgnorePrintAreas:=False, _
                         OpenAfterPublish:=False
  Application.EnableEvents = True
End Sub

Private Sub Workbook_Activate()
Application.CutCopyMode = False
Application.OnKey "^c", ""
Application.CellDragAndDrop = False
End Sub

Private Sub Workbook_Deactivate()
Application.CellDragAndDrop = True
Application.OnKey "^c"
Application.CutCopyMode = False
End Sub

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
Application.CutCopyMode = False
Application.OnKey "^c", ""
Application.CellDragAndDrop = False
End Sub

Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
Application.CellDragAndDrop = True
Application.OnKey "^c"
Application.CutCopyMode = False
End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Cancel = True
MsgBox "Right click menu deactivated." & vbCrLf & _
"Cannot copy or ''drag & drop''.", 16, "For this workbook:"
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.CutCopyMode = False
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Application.OnKey "^c", ""
Application.CellDragAndDrop = False
Application.CutCopyMode = False
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Application.CutCopyMode = False
End Sub

Private Sub Workbook_Open()
If Now() > #3/15/2039# Then Call SuicideSub ' #mesec/den/godina#
End Sub

in Module 11
Sub ProtectAll()

Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
ws.Protect Password:=k0s, DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
Next ws

End Sub

Sub DeProtectAll()

Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
ws.Unprotect Password:=k0s
Next ws

End Sub

in Module 1 your CODE

Option Explicit

Private fso As Scripting.FileSystemObject

Public Function GetAFolder(filePath As String) As Scripting.folder
    Set fso = New Scripting.FileSystemObject

    Dim someFolder As Scripting.folder
    Set someFolder = fso.GetFolder(filePath)
  
    Set GetAFolder = someFolder
End Function

Sub ProcessFiles()

    Set fso = New Scripting.FileSystemObject
  
    'access folder
    Dim folder As Scripting.folder
    Set folder = GetAFolder("C:\Users\Nevidim\Desktop\.................") 'my path
  
    'export module to import later
    ThisWorkbook.VBProject.VBComponents("someModule").Export ThisWorkbook.Path & "\someModule.bas"
  
    'declare some vars
    Dim wb As Workbook
    Dim file As Scripting.file
    Dim fileExt As String
    Dim ws As Worksheet
    Dim codeString As String
  
    'loop folder
    For Each file In folder.Files
        'ignore non excel files
        If fso.GetExtensionName(file.Path) = "xlsx" Or fso.GetExtensionName(file.Path) = "xlsm" Then
            'open wb from file
            Set wb = Workbooks.Open(file.Path, False, False)
          
            'import module
            wb.VBProject.VBComponents.Import ThisWorkbook.Path & "\someModule.bas"
          
            'write code to all worksheet modules
            For Each ws In wb.Worksheets
                'get the code
                With ThisWorkbook.VBProject.VBComponents("VZIMANE MODULI").CodeModule 'this is the file with modules
                    codeString = .Lines(2, .CountOfLines)
                End With
              
                'write the code
                wb.VBProject.VBComponents(ws.CodeName).CodeModule.AddFromString codeString
            Next ws
          
            'get code from thisworkbook
            With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
                codeString = .Lines(2, .CountOfLines)
            End With
          
            'write code to the thisworkbook module of target file
            wb.VBProject.VBComponents("ThisWorkbook").CodeModule.AddFromString codeString
          
            'save and close
            wb.SaveAs ThisWorkbook.Path & "\" & Left(wb.Name, Len(wb.Name) - 4) & "xlsm", 52
            wb.Close True
        End If
    Next file
End Sub

in Module 2

Sub SuicideSub()
'courtesy Tom Ogilvy
With ThisWorkbook
.Saved = True
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
End Sub

You said you were writing sheet code to the worksheets of the exported file. Write the name of the worksheet that has that code in the parent file in this line:
With ThisWorkbook.VBProject.VBComponents("sheetNameWhereYouHaveSheetCode").CodeModule

---------------------------------------------------

I don't understand it, if it's the way I think, i.e. to have a macro in, for example, Sheet1(Sheet1), I don't have one.
Macros are only in Modules and ThisWorkbook


And how to get not only one module, but all of them, because in the line where I have to write it, the name of the module is only 1?

ThisWorkbook.VBProject.VBComponents("Module2" how to put Module11, Module1).Export........................

 

[K0st4din]

https://drive.google.com/file/d/11XoDYuziPz0at-QmL8t-J8nW8u2R-op9/view?usp=sharing

link to my file to download