XL 2010 non fonctionnement du code VBA sur un autre pc

[Stedemart]

Bonjour,

J'ai un soucis sur une macro vba qui fonctionne bien sur mon pc mais qui se bloque sur le pc d'une collègue, peut être du a des soucis de sécurité excel/vba ?

Alors le code de bouton est le suivant, il avait été réalisé par un stagiaire, il sert à recupérer sur plusieurs fichiers de controle de mesure poids excel toujours dans le meme format, des données pour les copier coller dans un fichier de compil appelé ecart type et de mettre une date sur le fichier de base pour noter que l'export a bien été réalisé :
La macro est la suivante associé à un bouton :

</>
----------------------------------------------------------------------------------------------------
Function FichOuvert(F As String) As Boolean

On Error Resume Next
FichOuvert = Not Workbooks(F) Is Nothing
End Function


Sub VBA_Test()

'Private Sub ET_Click()
Dim dl As Integer, derlig As Integer
Dim madate As Date
Dim poids_sachet As Integer, tare_sachet As Integer
Dim TU1 As Integer, TU2 As Integer
Dim produit_emballé As String, code_article, numéro_lot As String, OF
Dim A As String, intitulé_B As String, C As String, D As String, E As String, F As String, G As String, L As String, M As String, N As String, O As String
Dim tablo, tabloR(), k%, i%

'affiche un message d'erreur si la valeur de la tare n'est pas rentrée

If Worksheets("Contrôles sachets").Cells(8, 3).Value = "" Then

MsgBox ("La valeur de la TARE n'a pas été indiquée, veuillez la saisir. ")

End If

'affiche la date et l'heure à laquelle la personne a cliqué sur le bouton, la date est placée en L7. Il faut donc placer le bouton juste au dessus ou au dessous.

With [L7]
.Value = Now
.NumberFormat = "dd/mm/yyyy hh:mm"
End With


'copie les valeurs de "Contrôles sachets"

With Sheets("Contrôles sachets")
dl = .Range("C" & Rows.Count).End(xlUp).Row 'last line
'-------------------- ENTÊTES -- Not useful --------------------------------
' A = .Range("A5")
' B = .Range("G6")
' C = .Range("I6")
' D = .Range("D8")
' E = .Range("A8")
' F = .Range("A10")
' G = .Range("B11")
' L = .Range("G8")
' M = .Range("I8")
' N = .Range("A7")
' O = .Range("A6")

'-------------------- INFORMATIONS DES ENTÊTES--------------------------

madate = .Range("C5")
poids_sachet = .Range("F8")
tare_sachet = .Range("C8")
TU1 = .Range("H8")
TU2 = .Range("J8")
produit_emballé = .Range("C6")
code_article = .Range("C7")
numéro_lot = .Range("H6")
OF = .Range("J6")

'-------------------- BDD---------------------------------------------

tablo = .Range("A11:G" & dl)
k = 0

'colle les valeurs dans auto2

For i = 1 To UBound(tablo, 1) Step 4
If tablo(i, 3) <> "" Then
ReDim Preserve tabloR(1 To 16, 1 To k + 2)
tabloR(2, 2 + k) = DateValue(madate)
tabloR(3, 2 + k) = numéro_lot
tabloR(4, 2 + k) = OF
tabloR(5, 2 + k) = poids_sachet
tabloR(6, 2 + k) = tare_sachet
tabloR(7, 2 + k) = tablo(i, 1)
tabloR(8, 2 + k) = tablo(i, 3)
tabloR(9, 2 + k) = tablo(i, 4)
tabloR(10, 2 + k) = tablo(i, 5)
tabloR(11, 2 + k) = tablo(i, 6)
tabloR(12, 2 + k) = tablo(i, 7)
tabloR(13, 2 + k) = TU1
tabloR(14, 2 + k) = TU2
tabloR(15, 2 + k) = code_article
tabloR(16, 2 + k) = produit_emballé
k = 1 + k
'colle les intitulés des valeurs
tabloR(2, 1) = A
tabloR(3, 1) = B
tabloR(4, 1) = C
tabloR(5, 1) = D
tabloR(6, 1) = E
tabloR(7, 1) = F
tabloR(8, 1) = G
tabloR(9, 1) = G
tabloR(10, 1) = G
tabloR(11, 1) = G
tabloR(12, 1) = G
tabloR(13, 1) = L
tabloR(14, 1) = M
tabloR(15, 1) = N
tabloR(16, 1) = O



End If



Next i

If FichOuvert("ecart-type.xlsx") Then
'Workbooks("ecart-type.xlsx").Sheets("auto2").Range("A2").CurrentRegion.Offset(1, 0).ClearContents

derlig = Workbooks("ecart-type.xlsx").Sheets("auto2").Range("b" & Rows.Count).End(xlUp).Row + 1



On Error Resume Next
Workbooks("ecart-type.xlsx").Sheets("auto2").Range("A" & derlig).Resize(UBound(tabloR, 2), 15) = Application.Transpose(tabloR)
Erase tablo: Erase tabloR

Else
MsgBox "Le classeur ecart-type.xlsx n'est pas ouvert, " & Chr(10) & Chr(10) & "Transfert des données impossible.": Exit Sub
End If
End With



End Sub
</>
----------------------------------------------------------------------------------------------------------------
Déjà de base, elle a le message d'erreur comme quoi son fichier ecart type n'est pas ouvert.

Elle ouvre pourtant le fameux fichier ecart-type.xlsx...et le transfert des données est impossible.

Cette macro fonctionne bien sur mon pc, je ne comprend pas d'où vient le soucis.

Nous sommes sur excel 2010.

Merci pour votre aide.

 

[patricktoulon]

Bonjour
mettez votre code entre balise code SVP pour que l'on puisse le lire sans devoir se taper 4 kilomètre de page

 

[HvbaL]

Vive les stagiaires qui automatisent les tâches ! (mon cas actuellement ^^')

Petite question avant même d'entrer dans le code, vous avez bien la même version d'excel ? pas de différence 32/64 bits ?
Quel serait le code d'erreur obtenu sur le 2nd poste ?

 

[Stedemart]

Son message est lié à la message box :
MsgBox "Le classeur ecart-type.xlsx n'est pas ouvert, " & Chr(10) & Chr(10) & "Transfert des données impossible.":

 

[HvbaL]

Il manque donc un classeur ouvert sur son poste je dirais, sinon un problème dans le code que tu as mis plus haut, et qu'il faudrait éditer comme demandé par patricktoulon pour qu'on y voit qqch
Bonne soirée tt le monde

 

[Stedemart]

Merci pour vos réponses.

Oui nous avons bien la même version d'excel pourtant et les 2 en 64 bits.
Oui son message est bien lié au code comme si le fichier demandé n'etait pas ouvert, pourtant il l'est bien.

je vais essayer d 'editer le code pour une meilleure lisibilité de mon soucis.

Merci

Function FichOuvert(F As String) As Boolean

On Error Resume Next
FichOuvert = Not Workbooks(F) Is Nothing
End Function


Sub VBA_Test()

'Private Sub ET_Click()
Dim dl As Integer, derlig As Integer
Dim madate As Date
Dim poids_sachet As Integer, tare_sachet As Integer
Dim TU1 As Integer, TU2 As Integer
Dim produit_emballé As String, code_article, numéro_lot As String, OF
Dim A As String, intitulé_B As String, C As String, D As String, E As String, F As String, G As String, L As String, M As String, N As String, O As String
Dim tablo, tabloR(), k%, i%

'affiche un message d'erreur si la valeur de la tare n'est pas rentrée

If Worksheets("Contrôles sachets").Cells(8, 3).Value = "" Then

MsgBox ("La valeur de la TARE n'a pas été indiquée, veuillez la saisir. ")

End If

'affiche la date et l'heure à laquelle la personne a cliqué sur le bouton, la date est placée en L7. Il faut donc placer le bouton juste au dessus ou au dessous.

With [L7]
.Value = Now
.NumberFormat = "dd/mm/yyyy hh:mm"
End With


'copie les valeurs de "Contrôles sachets"

With Sheets("Contrôles sachets")
dl = .Range("C" & Rows.Count).End(xlUp).Row 'last line
'-------------------- ENTÊTES -- Not useful --------------------------------
' A = .Range("A5")
' B = .Range("G6")
' C = .Range("I6")
' D = .Range("D8")
' E = .Range("A8")
' F = .Range("A10")
' G = .Range("B11")
' L = .Range("G8")
' M = .Range("I8")
' N = .Range("A7")
' O = .Range("A6")

'-------------------- INFORMATIONS DES ENTÊTES--------------------------

madate = .Range("C5")
poids_sachet = .Range("F8")
tare_sachet = .Range("C8")
TU1 = .Range("H8")
TU2 = .Range("J8")
produit_emballé = .Range("C6")
code_article = .Range("C7")
numéro_lot = .Range("H6")
OF = .Range("J6")

'-------------------- BDD---------------------------------------------

tablo = .Range("A11:G" & dl)
k = 0

'colle les valeurs dans auto2

For i = 1 To UBound(tablo, 1) Step 4
If tablo(i, 3) <> "" Then
ReDim Preserve tabloR(1 To 16, 1 To k + 2)
tabloR(2, 2 + k) = DateValue(madate)
tabloR(3, 2 + k) = numéro_lot
tabloR(4, 2 + k) = OF
tabloR(5, 2 + k) = poids_sachet
tabloR(6, 2 + k) = tare_sachet
tabloR(7, 2 + k) = tablo(i, 1)
tabloR(8, 2 + k) = tablo(i, 3)
tabloR(9, 2 + k) = tablo(i, 4)
tabloR(10, 2 + k) = tablo(i, 5)
tabloR(11, 2 + k) = tablo(i, 6)
tabloR(12, 2 + k) = tablo(i, 7)
tabloR(13, 2 + k) = TU1
tabloR(14, 2 + k) = TU2
tabloR(15, 2 + k) = code_article
tabloR(16, 2 + k) = produit_emballé
k = 1 + k
'colle les intitulés des valeurs
tabloR(2, 1) = A
tabloR(3, 1) = B
tabloR(4, 1) = C
tabloR(5, 1) = D
tabloR(6, 1) = E
tabloR(7, 1) = F
tabloR(8, 1) = G
tabloR(9, 1) = G
tabloR(10, 1) = G
tabloR(11, 1) = G
tabloR(12, 1) = G
tabloR(13, 1) = L
tabloR(14, 1) = M
tabloR(15, 1) = N
tabloR(16, 1) = O



End If



Next i

If FichOuvert("ecart-type.xlsx") Then
'Workbooks("ecart-type.xlsx").Sheets("auto2").Range("A2").CurrentRegion.Offset(1, 0).ClearContents

derlig = Workbooks("ecart-type.xlsx").Sheets("auto2").Range("b" & Rows.Count).End(xlUp).Row + 1



On Error Resume Next
Workbooks("ecart-type.xlsx").Sheets("auto2").Range("A" & derlig).Resize(UBound(tabloR, 2), 15) = Application.Transpose(tabloR)
Erase tablo: Erase tabloR

Else
MsgBox "Le classeur ecart-type.xlsx n'est pas ouvert, " & Chr(10) & Chr(10) & "Transfert des données impossible.": Exit Sub
End If
End With



End Sub

 

[cp4]

Merci pour vos réponses.

Oui nous avons bien la même version d'excel pourtant et les 2 en 64 bits.
Oui son message est bien lié au code comme si le fichier demandé n'etait pas ouvert, pourtant il l'est bien.

je vais essayer d 'editer le code pour une meilleure lisibilité de mon soucis.

Merci

Function FichOuvert(F As String) As Boolean

On Error Resume Next
FichOuvert = Not Workbooks(F) Is Nothing
End Function


Sub VBA_Test()

'Private Sub ET_Click()
Dim dl As Integer, derlig As Integer
Dim madate As Date
Dim poids_sachet As Integer, tare_sachet As Integer
Dim TU1 As Integer, TU2 As Integer
Dim produit_emballé As String, code_article, numéro_lot As String, OF
Dim A As String, intitulé_B As String, C As String, D As String, E As String, F As String, G As String, L As String, M As String, N As String, O As String
Dim tablo, tabloR(), k%, i%

'affiche un message d'erreur si la valeur de la tare n'est pas rentrée

If Worksheets("Contrôles sachets").Cells(8, 3).Value = "" Then

MsgBox ("La valeur de la TARE n'a pas été indiquée, veuillez la saisir. ")

End If

'affiche la date et l'heure à laquelle la personne a cliqué sur le bouton, la date est placée en L7. Il faut donc placer le bouton juste au dessus ou au dessous.

With [L7]
.Value = Now
.NumberFormat = "dd/mm/yyyy hh:mm"
End With


'copie les valeurs de "Contrôles sachets"

With Sheets("Contrôles sachets")
dl = .Range("C" & Rows.Count).End(xlUp).Row 'last line
'-------------------- ENTÊTES -- Not useful --------------------------------
' A = .Range("A5")
' B = .Range("G6")
' C = .Range("I6")
' D = .Range("D8")
' E = .Range("A8")
' F = .Range("A10")
' G = .Range("B11")
' L = .Range("G8")
' M = .Range("I8")
' N = .Range("A7")
' O = .Range("A6")

'-------------------- INFORMATIONS DES ENTÊTES--------------------------

madate = .Range("C5")
poids_sachet = .Range("F8")
tare_sachet = .Range("C8")
TU1 = .Range("H8")
TU2 = .Range("J8")
produit_emballé = .Range("C6")
code_article = .Range("C7")
numéro_lot = .Range("H6")
OF = .Range("J6")

'-------------------- BDD---------------------------------------------

tablo = .Range("A11:G" & dl)
k = 0

'colle les valeurs dans auto2

For i = 1 To UBound(tablo, 1) Step 4
If tablo(i, 3) <> "" Then
ReDim Preserve tabloR(1 To 16, 1 To k + 2)
tabloR(2, 2 + k) = DateValue(madate)
tabloR(3, 2 + k) = numéro_lot
tabloR(4, 2 + k) = OF
tabloR(5, 2 + k) = poids_sachet
tabloR(6, 2 + k) = tare_sachet
tabloR(7, 2 + k) = tablo(i, 1)
tabloR(8, 2 + k) = tablo(i, 3)
tabloR(9, 2 + k) = tablo(i, 4)
tabloR(10, 2 + k) = tablo(i, 5)
tabloR(11, 2 + k) = tablo(i, 6)
tabloR(12, 2 + k) = tablo(i, 7)
tabloR(13, 2 + k) = TU1
tabloR(14, 2 + k) = TU2
tabloR(15, 2 + k) = code_article
tabloR(16, 2 + k) = produit_emballé
k = 1 + k
'colle les intitulés des valeurs
tabloR(2, 1) = A
tabloR(3, 1) = B
tabloR(4, 1) = C
tabloR(5, 1) = D
tabloR(6, 1) = E
tabloR(7, 1) = F
tabloR(8, 1) = G
tabloR(9, 1) = G
tabloR(10, 1) = G
tabloR(11, 1) = G
tabloR(12, 1) = G
tabloR(13, 1) = L
tabloR(14, 1) = M
tabloR(15, 1) = N
tabloR(16, 1) = O



End If



Next i

If FichOuvert("ecart-type.xlsx") Then
'Workbooks("ecart-type.xlsx").Sheets("auto2").Range("A2").CurrentRegion.Offset(1, 0).ClearContents

derlig = Workbooks("ecart-type.xlsx").Sheets("auto2").Range("b" & Rows.Count).End(xlUp).Row + 1



On Error Resume Next
Workbooks("ecart-type.xlsx").Sheets("auto2").Range("A" & derlig).Resize(UBound(tabloR, 2), 15) = Application.Transpose(tabloR)
Erase tablo: Erase tabloR

Else
MsgBox "Le classeur ecart-type.xlsx n'est pas ouvert, " & Chr(10) & Chr(10) & "Transfert des données impossible.": Exit Sub
End If
End With



End Sub

Quelle est la ligne de code surlignée (où se produit l'erreur)?

 

[eriiic]

Bonjour,
En supposant que le nom est bien correct, le fichier n'est pas ouvert dans une autre session des fois ?
Qu'elle l'ouvre depuis celle du fichier des macros.
eric

 

[Stedemart]

Bonjour, la fonction FichOuvert n'est pas reconnue et à l'air non définie :

 

[Stedemart]

Bonjour,
En supposant que le nom est bien correct, le fichier n'est pas ouvert dans une autre session des fois ?
Qu'elle l'ouvre depuis celle du fichier des macros.
eric

non elle l'ouvre bien sur la même session pourtant, depuis le même fichier source.

 

[cp4]

Bonjour,

@Stedemart : J'ai testé chez moi la fonction, elle fonctionne parfaitement. Cependant, le fichier est préalablement ouvert.

Alors comment ouvres-tu ce fichu fichier qui cause problème, par code ou manuellement?

 

[Stedemart]

Elle l'ouvre manuellement soit depuis notre réseau interne en double cliquant dessus depuis l'explorateur windows de notre réseau, soit en ouvrant excel et en allant chercher le fichier depuis Excel.

Comment peut elle l'ouvrir par code ?

d'avance merci pour vos réponses

 

[cp4]

Elle l'ouvre manuellement soit depuis notre réseau interne en double cliquant dessus depuis l'explorateur windows de notre réseau, soit en ouvrant excel et en allant chercher le fichier depuis Excel.

Comment peut elle l'ouvrir par code ?

d'avance merci pour vos réponses

voir cette discussion

 

[Stedemart]

Merci beaucoup