Discussion :

[many6976]

Salut tout le monde!

Dans le cadre d'un stage (en mécanique.. HAHA), on m'a demandé de créer une base de données.
Sans préciser plus le sujet du projet, je vais vous expliquer mon souci.

Nous utilisons CATIA, avec de la conception paramétrique. Pour ceux qui ne connaissent pas, ça veut dire qu'on fait un fichier 3D, par exemple une vis, auquel on joint un fichier Excel contenant des dimensions (une colonne diamètre, une colonne longueur, et donc par ligne un type de vis, et quand sur CATIA on sélectionne la ligne, la vis change de dimensions).

Le problème est que pour mon projet, je dois répartir tous les fichiers 3D dans des dossiers propres (un dossier par fichier) sachant qu'à l'origine, ils sont tous ensemble, et que leurs fichiers Excel sont fusionnés (par l'ancien stagiaire je crois).

Il faut donc répartir chaque worksheet dans un dossier, en prenant en compte que les noms ne correspondent pas toujours précisément, car la place est limitée pour les noms des worksheets (et l'ancien stagiaire n'était pas des plus rigoureux...)
Par ex nom du fichier: ECROU CLUFIX HEXAGONALE TETE PLATE
nom de la worksheet: ECROU CLUFIX HEX. TETE PLATE

Vu le nombre de fichiers comme ça, j'aimerais faire une macro, sachant que j'ai déjà fait une macro pour créer les dossiers et mettre les fichiers 3D dedans, (et que j'ai commencé à faire de la VBA avant-hier... Vive les tutoriels )

Je sais pas si je suis très claire, mais bon

Enfin je vais bien sûr continuer de chercher, mais si quelqu'un pouvait m'aider, ce serait génial! (parce que je pourrais enfin faire de la méca u_u)

[many6976]

Je me rends compte que mon message donne l'impression que je n'ai pas cherché...
J'ai pensé qu'il serait possible d'extraire des tableaux des noms de mes dossiers et des feuilles excel grâce à la fonction extractionMots de Silkyroad, et ainsi comparer 2 à 2 les éléments de ces tableaux, mais comme les noms ne sont pas strictement identiques, mais les premiers et derniers éléments normalement oui, peut-être que je pourrais juste comparer les premiers et derniers termes.

Mais il me reste le problème d'extraction des feuilles d'Excel.

[BlueMonkey]

Salut,

Essaye en faisait une correspondance nom d'onglet de classeur / nom de dossier,
à partir d'une correspondance de syllabes.
Code à coller dans un module du classeurs Excel contenant toutes les feuilles à exporter.

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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
 
'Nécessite l'ajout de la référence depuis le menu Option->Référence.
'Sélectionne la référence  : Microsoft Scripting Runtime
Option Explicit
 
Const MainDossier As String = "C:\Mon Dossier contenant les sous dossiers déjà créés "
Const SEPARATOR As String = " "
 
Sub CopieMesFeuillesDansMainDossier()
    Dim ListeSousDossier() As String
    GetSubFolders MainDossier, ListeSousDossier
    ExportWorksheetsToDossier ListeSousDossier
End Sub
 
Sub ExportWorksheetsToDossier(listeDossier() As String)
    Dim dossierDestination As String
    Dim ws As Worksheet
    For Each ws In Worksheets
        dossierDestination = FindFolder(Ucase(ws.name), listeDossier)
        If Len(dossierDestination) > 0 Then
            Dim wbToSave As Workbook
            ws.Copy
'           Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs MainDossier & "\" & dossierDestination & "\" & ws.name & ".xlsx"
            ActiveWorkbook.Close False
 '           Application.DisplayAlerts = True
        End If
    Next ws
End Sub
 
Function FindFolder(name As String, listeDossier() As String) As String
    Dim matchCount As Integer
    Dim bestMathCount As Integer
    Dim di As Integer
    For di = 1 To UBound(listeDossier)
        matchCount = GetCommunWordsCount(name, Ucase(listeDossier(di)))
        If matchCount > bestMathCount Then
            bestMathCount = matchCount
            FindFolder = listeDossier(di)
        End If
    Next di
 
End Function
 
Function GetCommunWordsCount(wd1 As String, wd2 As String) As Integer
    Const SEPARATOR As String = " "
    Dim w1Split() As String: w1Split = Split(wd1, SEPARATOR)
    Dim w2Split() As String: w2Split = Split(wd2, SEPARATOR)
    Dim splitCount As Integer
    splitCount = IIf(UBound(w1Split) < UBound(w2Split), UBound(w1Split), UBound(w2Split))
 
    GetCommunWordsCount = 0
    Dim wi As Integer
    For wi = 0 To splitCount
        If InStr(1, w1Split(wi), w2Split(wi)) > 0 Then
            GetCommunWordsCount = GetCommunWordsCount + 1
        End If
    Next wi
 
End Function
 
Sub GetSubFolders(dossierRacine As String, ByRef ListeSousDossier() As String)
    Dim fs As New FileSystemObject
    Dim dossier As Folder
    Dim di As Integer: di = 1
 
    With fs.GetFolder(dossierRacine)
        ReDim ListeSousDossier(.SubFolders.Count)
        For Each dossier In .SubFolders
            ListeSousDossier(di) = dossier.name
            di = di + 1
        Next dossier
    End With
 
    Set fs = Nothing
End Sub

[many6976]

Salut,

Merci, BlueMonkey, ça m'aide beaucoup!
Je n'ai pas tout utilisé parce que si je comparais 3 mots des noms, ça ne marchait pas toujours, et si je ne comparais que 2 mots, ça ne suffisait pas toujours... Donc j'ai plutôt utilisé une extraction des noms, puis une comparaison du premier et dernier noms, ce qui - jusque-là - se compile.
Mais j'ai un souci avec (voir "=>"):

Code :

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

1
2
3
4
5
If (UBound(nom0) = UBound(nom1)) And (LBound(nom0) = LBound(nom1)) Then
     oWS.Copy
=>  ActiveWorkbook.SaveAs oFSO.GetAbsolutePathName(MonDossier) & "\" & oFSO.GetBaseName(MonFichier) & "\" & oWS.name & ".xlsx" 
      ActiveWorkbook.Close False
End If

Il me sort que Microsoft Excel ne peut accéder à ce fichier parce que:
Soit le nom du fichier ou le chemin n'existe pas, soit il est utilisé ailleurs.

Le chemin qu'il m'indique existe, et personne d'autre n'utilise ce fichier...

Ou alors j'ai peut-être pas compris ce passage de ton code

[BlueMonkey]

Bonjour,

Je pense que "\" & oFSO.GetBaseName(MonFichier) et "\" & oWS.name fond double emploi pour le nom de fichier.
Essaye avec l'un ou l'autre dans la ligne :

Code :

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

ActiveWorkbook.SaveAs oFSO.GetAbsolutePathName(MonDossier) & "\" & oFSO.GetBaseName(MonFichier) &  ".xlsx"

ou

Code :

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

ActiveWorkbook.SaveAs oFSO.GetAbsolutePathName(MonDossier) & "\" &  oWS.name & ".xlsx"

A+

[many6976]

Re-Salut,

En fait, je te montre l'adresse:
C:\Documents and Settings\mon_nom\Desktop\test\test.xls
C'est pour ça que ça apparaît deux fois, mon fichier Excel doit prendre le même nom que mon dossier, qui lui-même a le même nom que mon composant CATIA.

Au fait, je reviens sur le code que tu m'as envoyé, il y a un bout avec lequel je ne sais pas quoi faire:

Code :

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

Dim wbToSave As Workbook

Est-ce que j'ai raté quelque chose?

Quand j'exécute mon code, il ouvre un nouveau classeur mais celui que je veux copier s'ouvre en lecture seule. Je ne comprends pas pourquoi

Si t'as des réponses!

A+, bonne soirée!