Discussion :

[der43e]

Bonjour a tous,

voila je devient un peut fou...

je vous explique, mon but et de créer un UserForm qui me liste mes onglets, je peut selectioner les onglets que je souhaite et presser un boutons qui me permet de créer un nouveau fichier excel dans le quelle je vient copier mes onglet selectioner!

Le nom de ce nouveau fichier étant nouveau a chaque fois je souhaite pouvoir le rentrer dans une zone de texte de mon UserForm et le récupérer dans mon code.

Déja voici le code en question pour créer un fichier avec le nom que j'ai entré ( ce code fonctionne bien mon fichier ce crée et s'ouvre avec le bon nom!)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub CommandButton3_Click()
 
'Recuperation du nom de la commande
NomCommande = UserForm2.TBNom
'Création d'un autre fichier
Dim XL As New Excel.Application
Workbooks.Add
Sheets("Feuil1").Select
Sheets("Feuil1").Name = NomCommande
'ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & NomCommande & ".xlsx"
ActiveWorkbook.SaveAs Filename:="C:\Users\User1\Bureau\Gestion des com\" & NomCommande & ".xlsx"
'ActiveWorkbook.Close
Set exc = Nothing
End Sub

Voici pour info le code a l'initialisation de mon UserForm:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Sub UserForm_Initialize() 'à l'initialisation de l'UserForm
Dim O As Worksheet ''déclare la variable O (Onglets)
 
Set CS = ThisWorkbook 'définit le classeur source CS
 
For Each O In CS.Sheets 'boucle sur tous les onglets du classeur source CS
    Me.ListBox1.AddItem O.Name 'ajoute le nom d el'onglet à la ListBox1
Next O 'prochain onglet de la boucle
End Sub

et voici le code sur un deuxieme bouton pour copier les onglet

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Private Sub CommandButton1_Click() 'bouton "Copier"
Dim TOS() As Variant 'déclare la varaible TOS (Tableau des Ongles Sélectionnées)
 
 
 
'Recuperation du nom de la commande
Dim NomCommandeSimple As String
Dim NomCommande As String
NomCommandeSimple = UserForm2.TBNom
NomCommande = UserForm2.TBNom & ".xlsx"
 
'TEST
 
'TEST
 
Set CD = Workbooks(NomCommandeSimple & ".xlsx")   'définit le classeur destination
 
With Me.ListBox1 'prend en compte la ListBox1
    For i = 0 To .ListCount - 1 'boucle  sur tous les éléments
        If .Selected(i) = True Then 'condition : si l'élément est sélectionné
            ReDim Preserve TOS(J) 'redimensionne le tableau TOS
            TOS(J) = .List(i) 'récupère le nom de l'ong;et sélectionné
            J = J + 1 'incrémente J
        End If 'fin de la condition
    Next i 'prochain élément de la boucle
End With 'fin de la prise en compte de la ListBox1
'copie les onglets du tableau TOS après le dernier onglet du classeur de destination CD
 
Sheets(TOS).Copy After:=CD.Sheets(CD.Sheets.Count)
'Suppretion des feuille sur le fichier de base
CS.Sheets(TOS).Delete
Unload Me 'vide et ferme l'UserForm1
End Sub

Hors, la j'ai une erreur de type 9: L'indice n'appartien pas à la selection sur la ligne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets(TOS).Copy After:=CD.Sheets(CD.Sheets.Count)

Si par contre a ma ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set CD = Workbooks(NomCommandeSimple & ".xlsx")

je rentre le nom du fichier en tout lettre par exemple Test.xslx que je crée ce fichier et que je l'ouvre la copie fonctionne
Si je crée mon fichier avec le premier bouton, que je referme mon userform que je le réouvre et que je fait simplement le bouton copie en entrent le nom de mon fichier (Test) cela fonctionne aussi...

Je supose donc que le problème vient du fait que je ne doit pas bien entre le contenue de ma variable...
Ou alors que le fichier séléctionner n'est pas dans les fichiers actif mais je ne sais pas comment faire cela...

Ou est ce que vous savez d'ou cela peut venir??

Merci d'avance!!

[sogedic]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set CD = Workbooks(NomCommandeSimple & ".xlsx")

le fichier doit être ouvert dans la même application Excel


apres avoir activé la reference "Microsoft scripting runtime"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
'----------------------------------------
'Teste si un item est dans une collection
'----------------------------------------
Function IsInCollection(ByRef Coln As Object, ByVal item As String) As Boolean
    Dim obj As Object
    On Error Resume Next
    Set obj = Coln(item)
    IsInCollection = Not obj Is Nothing
    err.Clear
 
End Function
'----------------------------------------
'Teste si un classeur est ouvert dans une application Excel donn?e
'----------------------------------------
Function IsOpenWb(ByVal WbName As String, ByRef Appli As Application) As Boolean
   IsOpenWb = IsInCollection(Appli.Workbooks, WbName)
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
'----------------------------------------
'Ouvrir un fichier Excel
'----------------------------------------
Function OpenFile(PathFile As String) As Boolean
 
    Dim oFSO    As Scripting.FileSystemObject
    Dim sPath   As String
 
    'Init
    On Error GoTo ERRHANDLER
    Set oFSO = New Scripting.FileSystemObject
 
    'Ouvrir le fichier
    If IsOpenWb(oFSO.GetFileName(PathFile), ThisWorkbook.Application) Then
        Workbooks(oFSO.GetFileName(PathFile)).Activate
    Else
        sPath = ThisWorkbook.Path
            If Not (oFSO.FileExists(oFSO.BuildPath(sPath, PathFile))) Then
                MsgBox "Le fichier n'existe pas - Fin du traitement"
                OpenFile = False: Exit Function
            End If
            set wD =Workbooks.Open (oFSO.BuildPath(sPath, PathFile))
    End If
 
    'Fin
    OpenFile = True
    Exit Function
 
ERRHANDLER:
    Select Case err.Number
        Case 53: MsgBox "Le fichier est introuvable"
        Case Else: MsgBox "Erreur inconnue"
    End Select
 
End Function

[der43e]

Bonjour sogedic et merci pour ton aide,

Alors, le fichier est belle et bien ouvert et nouvellement créer grâce a mon code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub CommandButton3_Click()
 
'Recuperation du nom de la commande
NomCommande = UserForm2.TBNom
'Création d'un autre fichier
Dim XL As New Excel.Application
Workbooks.Add
Sheets("Feuil1").Select
Sheets("Feuil1").Name = NomCommande
'ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & NomCommande & ".xlsx"
ActiveWorkbook.SaveAs Filename:="C:\Users\User1\Bureau\Gestion des com\" & NomCommande & ".xlsx"
'ActiveWorkbook.Close
Set exc = Nothing
End Sub

Je suis débutent dans le VBA, j'ai bien activé la référence "Microsoft scripting runtime", j'ai bien créer les fonction mais comment les utilisé après?

Navré pour mon inconnaissance ;-)

et merci pour ton aide!

[der43e]

Bonjour, alors j'ai trouvé la cause du Bug, en le créant en même temps que je voulait le copier il ne savais plus quelle était le fichier actifs ( mon fichier source)

voila le code qui m'as permis de régler le problème!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
Dim fichiesource As String
fichiesource = fichiersource.xlsm
Set CZ = Workbooks(fichiesource) 
CZ.Sheets(TOS).Copy After:=CD.Sheets(CD.Sheets.Count)

merci quand même pour votre aide et bonne journée!