View Full Version : Advice needed
walden
11-20-2016, 06:16 AM
Hello,
I need again your advice... Here we are, I try at present to develop a file named "Create" the purpose of which is of:
1. Establish participants' list
2. Create a name specific file of every participant selected in the list. This file is a copy of a file named "Template".
I concerns is the following one: this file "Creation" will be distributed with the file "Template". This 2 files contain a lot of macro. I would have liked that the file Template is not accessible(approachable) to see invisible for the user to avoid any accident (deletion or movement of the file Template).
Have you an idea of the way I could take myself there?
Thank you very much, 
Friendly
walden
11-21-2016, 05:37 AM
Hello everybody, 
Here is where I am there: I inserted the file Template as object in the file Creation and I coded the button "Bt_Create" as follows:
Private Sub Bt_Create_Click()
Dim chemin As String
Dim objShell As Object, objFolder As Object, oFolderItem As Object
Dim i As Integer
Dim fich As String, file As String, dep As String
Dim wb As Workbook
Dim Cel As Range
Dim Depart As Long
Dim FName As String, mPath
Dim obj
    Application.ScreenUpdating = False
    mPath = "C:\My Documents\"
    For Each obj In Worksheets(2).OLEObjects
     If obj.Name = "TEST" Then
     Application.EnableEvents = False
     obj.Verb
     obj.Object.Activate
     obj.Object.SaveAs mPath & "TEST_success.xlsm"
     obj.Object.Close
    End If
     i = i + 1
    Next
    FName = BrowseFolder("Select A Folder")
    If Dir(FName, vbDirectory) <> vbNullString Then
       chemin = FName
       file = "C:\Mon Espace Disque\HSE\4- 2016\TEST_success.xlsm"
       For i = 0 To LBFichier.ListCount - 1
       Set Cel = Sheets("ListeCode").Columns("B").Find(what:=Me.LBFichier.List(i, 0), LookIn:=xlValues, lookat:=xlWhole)
                If Not Cel Is Nothing Then
                    Depart = Cel.Row
                    Sheets("ListeCode").Range("C" & Depart).Value = Sheets("ListeCode").Range("C" & Depart).Value + 1
                    dep = Sheets("ListeCode").Range("D" & Depart).Value
                End If
           fich = Me.LBFichier.List(i, 0) & " (" & dep & ")"
           Set wb = Workbooks.Open(file)
           wb.Worksheets("Liste par section").Range("B1").Value = Me.LBFichier.List(i, 0)
           wb.Worksheets("Liste par section").Range("B2").Value = dep
           ActiveWorkbook.SaveAs Filename:=chemin & fich
           wb.Close
           Set Cel = Nothing
           Application.EnableEvents = True
        Next i
        LBFichier.Clear
        MsgBox "Everything is ok"
     End If
     
     Kill "C:\My Documents\TEST_success.xlsm"
    Application.ScreenUpdating = True
End Sub
This code works more or less in mode step by step...
In automatic, several problems appear:
1. During the protection(saving) of the file Template
2. On the line "Set wb = Workbooks. Open", it does not find that wb is the file Template
If one of you could have a look on my code, he would know about it very grateful
Good day, 
Friendly
walden
11-21-2016, 09:55 PM
Hello everyone, 
Do you have no idea or is it too... bad ??
Thank a lot,
Best regards
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.