XL 2010 non fonctionnement du code VBA sur un autre pc

Stedemart

XLDnaute Nouveau
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.
 
Dernière édition:

patricktoulon

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

HvbaL

XLDnaute Nouveau
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

XLDnaute Nouveau
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


VB:
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

XLDnaute Barbatruc
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


VB:
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)?
 

Stedemart

XLDnaute Nouveau
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
 

Discussions similaires

Réponses
14
Affichages
618
Réponses
6
Affichages
202