PDA

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