Discussion :

[quentinvba]

Bonjour,

Je débute en VBA et ai créé une macro dans Perso.xls qui fonctionne très bien. Or celle-ci est destinée à être utilisée sur d'autres ordinateurs.
Je l'ai donc naïvement transféré par copier coller de Perso.xls dans Thisworkbook(en changeant les noms des procédures uniquement), pensant que cela n'occasionnerait aucun problème. Voici ma macro :

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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
 Sub Delete()
 
 
'Supprime les fichiers photos associés aux liens hypertextes, supprime la ligne et en fait une copie de la ligne dans Sorties"
Confirmation = MsgBox("Confirmer la suppression irréversible de la ligne et de ses photos ?", vbYesNo + vbCritical + vbDefaultButton2)
    If Confirmation = vbYes Then
 
        Call Selectionner
        Call SupprimerPhoto
        Call SupprCellHyper
        Call CopieExt
 
    Else: Exit Sub
    End If
 
Ligne = ActiveCell.Row
Rows(Ligne).Delete
 
End Sub
 
 
Sub Selectionner()
'permet de selectionner uniquement la plage contenant des données sur la ligne où la cellule est active'
Range(Range("A" & ActiveCell.Row), Range("IV" & ActiveCell.Row).End(xlToLeft)).Select
End Sub
 
 
Sub SupprimerPhoto()
 
'supprime les fichiers sources des liens hypertexte'
 
'Dim Compteur As Integer
'Compteur = Selection.Hyperlinks.Count (probablement inutile)
 
Set fso = CreateObject("Scripting.FileSystemObject")
 
For Each h In Selection.Hyperlinks
            If fso.FileExists(h.Address) = True Then
            AdrHyperlien = h.Address
            Kill (AdrHyperlien)
            'Compteur = Compteur - 1 (probablement inutile)
            End If
Next
 
 
'passe les liens hypertexte en mode texte'
Range(Range("A" & ActiveCell.Row), Range("IV" & ActiveCell.Row).End(xlToLeft)).Select
 
Selection.Hyperlinks.Delete
 
 
End Sub
 
 
 
Sub SupprCellHyper()
 
'supprime le contenu des cellules en fonction des caractères par lesquelles elles commencent pour effacer le texte des liens hypertexte"
    Dim cell As Range
 
Set DataRange = Selection
 
    For Each cell In DataRange
        If Left$(cell.Value, 3) = "C:\" Then cell.ClearContents
    Next
    For Each cell In DataRange
        If Left$(cell.Value, 3) = "K:\" Then cell.ClearContents
    Next
    For Each cell In DataRange
        If Left$(cell.Value, 3) = "..\" Then cell.ClearContents
    Next
    For Each cell In DataRange
        If Left$(cell.Value, 9) = "\\serveur" Then cell.ClearContents
    Next
 
End Sub
 
 
Sub CopieExt()
 
Dim Celdest As String
Dim NomFeuille As String
NomFeuille = ActiveSheet.Name
 
'ouvrir classeur, insérer la date'
Application.Workbooks.Open "K:\Sorties"
Worksheets(NomFeuille).Activate
 
    If Range("A2").Value = "" Then
        Range("A2").Value = Date
        Else
        Workbooks("Sorties").Sheets(NomFeuille).Range("A1").End(xlDown).Offset(1, O).Value = Date
    End If
 
'Copier ligne et l'insérer dans Sorties à droite de la date'
Range("A1").End(xlDown).Offset(0, 1).Name = "Celdest"
 
Windows("Sources").Activate
 
Call Selectionner
 
Selection.Copy Destination:=Workbooks("Sorties").Sheets(NomFeuille).Range("CelDest")
 
Workbooks("Sorties").Save
 
Workbooks("Sorties").Close
 
 
End Sub

Si j'exécute ce code, j'obtiens une erreur 400.

Avec le débog pas à pas je détecte une erreur "objet non géré par l'application" au niveau de :
Application.Workbooks.Open "K:\Sorties"

J'imagine que le problème vient du fait que ma macro gère des données sur deux classeurs différents mais je ne sais pas comment faire pour effectivement affecter la macro au classeur ou à la feuille.

Pouvez-vous svp m'aiguiller ?

Merci par avance,

Quentin

[helas]

Bonjour,

Si Sorties est le fichier excel, preciser sorties.xls

[quentinvba]

Bonjour helas,

Merci pour ton aide. J'ai bien remplacé les sorties en sorties.xls mais cela ne fonctionne malheureusement toujours pas .

Précision : Il s'agit de l'erreur "1004" : Erreur définie par l'application ou par l'objet

[Invité]

Bonjour,
Thisworkbook ne veut rien dire du tou!

si tu parle de la module Thisworkbook ta macro ne sera visible que dans Thisworkbook.

il faut en dire un peut plus sur le code! les instruction comme activate par exemple ne fonctionne pas dans la méthode open par exemple, car par définition le classeur ne peut être activé lors de son ouverture!

pour t'aider il faut que nous intégrions le contexte!

[quentinvba]

Très bien je comprends, il est parfois difficile de savoir tous les éléments pouvant vous être utile sans maîtriser les subtilités de VBA.

Précisions sur le contexte :

Dans ma macro, ThisWorkbook désigne le classeur 1 ("Sources.xls"). La macro est exécutée à partir de la feuille "NomFeuille" de ce classeur étant ouvert.

Le bug apparait lorsque je souhaite ouvrir le classeur 2 ("Sorties.xls", fermé avant l'éxécution de la macro). Une feuille également intitulée "NomFeuille" s'y trouve. Je rappelle que ce bug n'existe pas si j'exécute la macro depuis Perso.XLS.

Je vous joins un Screenshot si cela peut vous aider



En fait ma question pourrait être : Où placer ma macro pour qu'elle s'exécute comme dans Perso.Xls mais disponible depuis d'autres ordinateurs/utilisateurs ?

[Invité]

surprime ton code de ThisWorkbook , ouvres ton classeur perso, maintiens le click gauche sur Module2 de perso et fait le glisser sur vbaproject de source.xls!