Bonjour,

J'ai un code qui créé un fichier en fonction du résulat d'une cellule.
Si quelque chose se trouve dans ma cellule alors il créé le fichier portant ce même nom.
Les chemins se situent sur Sharepoint.

Mon problème est que le fichier se créé bien, mais au moment de l'ouvrir il me dit
"Impossible d'ouvrir le fichier car son Extension ou son format n'est pas valide."

Le fichier est présent dans le répertoire mais est impossible à ouvrir même manuellement.

Après plusieurs recherche sur internet, le problème viendrait de "SaveAs" qui pourrait
endommager les fichiers. Cependant je ne sais pas comment faire autrement.

J'ai déjà exécuté ce code, parfois il copie sans endommager et d'autre fois il me fait cette erreur.


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
sub Crea()
 
Dim cheminMo, cheminCree as string
Dim Verif as Boolean
 
cheminMo = "https://..." 'Chemin sharepoint
cheminCree = "https://..." 'Chemin sharepoint
cheminCree = Replace(Replace(CheminCree, "https:", ""), "/", "\")
 
 
Sheets("Co").Select
 
For Each Cell In Sheets("Co").UsedRange.Columns("A").Cells
 
        If Cell.Row > 1 Then
 
  Num = Range("A" & Cell.Row).Value
  Sem = Range("K" & Cell.Row).Value
 
 File = Sem & ".xlsx"
 
Sheets("Part").select
 
For Each Ligne In Sheets("Part").UsedRange.Columns("A").Cells
 
Tld = Name & "_OK" & Num & ".xlsx"
 
If Tld = Ligne.value then
 
 Verif = true
 
 Tld = ""
 exit for
else
 Verif = False
end if
next
 
 
If Verif = False then
 
Workbooks.Open (cheminMo & File)
 
Application.DisplayAlerts = False
 
 ActiveWorkbook.SaveCopyAs cheminCree & Tld
 Workbooks.Open (cheminCree & Tld)
 
Range("A1").value = Num
 
end if
 
end if
 
Sheets("Co").Select
 
next 
 
end sub

Merci pour votre aide.