Modification d'un fichier Excel depuis Access (pas de changement)Résolu

Question

Bonjour,
Ce code VBA me permet via un bouton d'ouvrir et de modifier un fichier Excel. Une fois exécuté, le fichier apparaît mais sans avoir insérer ce que je voulais et je n'ai aucun message d'erreur. Une solution ? Merci.

Dim x1 As excel.Application
Dim work As excel.Workbook
Dim wrb As excel.Workbook
Set x1 = New excel.Application
x1.Visible = True
Set work = x1.Workbooks.Open("D:\PV_modele.xlsx")  'Démarrer Excel
Set wrb = x1.Workbooks.Item(1)
With wrb.Sheets(1) 'Insertion des valeurs
    .Range("I3").Value = val1 & "-" & val2 'codeProduit + designationProduit
    .Range("H5").Value = d 'date
    .Range("H6").Value = h 'heure
    .Range("H7").Value = tab1(25) 'operateur
    .Range("H8").Value = Me.cboMachine 'machine
    .Range("N5").Value = tab1(21) 'touret
    .Range("N6").Value = tab1(27) 'longueurTouret
    .Range("N7").Value = tab1(23) 'commande
    .Range("C15").Value = Round(CDec(tab1(64)), 2) 'epaisseurMin
    .Range("E15").Value = Round(CDec(tab1(63)), 2) 'epaisseurMoy
    .Range("G15").Value = Round(CDec(tab1(62)), 2) 'epaisseurMax
    .Range("I15").Value = Round(CDec(tab1(16)), 2) 'diametreMin
    .Range("L15").Value = Round(CDec(tab1(15)), 2) 'diametreMoy
    .Range("N15").Value = Round(CDec(tab1(14)), 2) 'diametreMax
    .Range("D15").Value = val3 'toleranceEpaisseurMin
    .Range("F15").Value = val4 'toleranceEpaisseurMoyMin
    .Range("H15").Value = val6 'toleranceEpaisseurMax
    .Range("J15").Value = val7 'toleranceDiametreMin
    .Range("K15").Value = val8 'toleranceDiametreMoyMin
    .Range("M15").Value = val9 'toleranceDiametreMoyMax
    .Range("O15").Value = val10 'toleranceDiametreMax
End With
Set wrb = Nothing
Set work = Nothing
Set x1 = Nothing

ucfoutu · Accepted Answer

Bonjour,
1) Le classeur ouvert contient-il des macros ? (car si ScreenUpdating à false ...)
2) wrb.Sheets(1) n'est pas prudent. Préfère te référer à cette feuille par son nom.
3)Dim val3, val4, val5, val6, val7, val8, val9, val10 As Single
fait que seule val10 est typée en single et donc (entre autres)
rien n'est alors moins sur que :
If CDec(tab1(64)) < val3 Then
car, par exemple, "1221" est < que "4"
etc ...
Passe en mode debug et vérifie le contenu exact de tes variables.
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

lolokun · Answer

Bonjour,

Tu n'enregistres pas les modifications effectuées, il faut que tu rajoute un save ou saveas

L'expérience, c'est une connerie par jour, mais jamais la même..

Majo64 · Answer

Ca ne change rien avec save et je veux juste afficher le fichier et le modifier, pas le sauvegarder.
Tout s'éxécute correctement au début, c'est à partir des lignes en gras que ça pose problème. Voici le code complet :

Option Compare Database
Option Explicit

Private Sub OK_Click()
Dim ch As String
Dim strligne As String
Dim tab1() As String
Dim deb As String
Dim fin As String
Dim tab2() As String
Dim d, h As String
Dim val1 As Long
Dim val2 As String
Dim val3, val4, val5, val6, val7, val8, val9, val10 As Single

Open "D:\Base mesure gainage\QUASAR.dat" For Input As #1
While Not EOF(1)
Line Input #1, strligne
Wend
Close 1

Dim i  As Integer
Dim dec As Single
tab1() = Split(strligne, vbTab) 'Découpe la chaine selon les espaces
For i = 0 To UBound(tab1())
    tab1(i) = Replace(tab1(i), ".", ",")
Next i
deb = InStr(strligne, "[") 'Recherche un crochet ouvrant
fin = InStr(strligne, "]") 'Recherche un crochet fermant
ch = Mid(strligne, deb, fin) 'Retourne une chaîne compris entre deux caractères
ch = Replace(ch, "[", "") 'Supprime le premier caractère
ch = Replace(ch, "]", "") 'Supprime le dernier caractère
ch = Replace(ch, " ", "") 'Supprime les espaces
tab2() = Split(ch, ",") 'Découpe la chaine selon les virgules
For i = 0 To UBound(tab2())
    tab2(i) = Replace(tab2(i), ".", ",")
Next i

Set db = CurrentDb()
Dim db As DAO.Database
Dim rst1, rst2 As DAO.Recordset
Set rst1 db.OpenRecordset("SELECT * FROM Produits WHERE idProduit " & Me.cboProduit.Column(0, Me.cboProduit.ListIndex))
val1 = rst1("codeProduit")
val2 = rst1("designationProduit")
val3 = rst1("toleranceEpaisseurMin")
val4 = rst1("toleranceEpaisseurMoyMin")
val5 = rst1("toleranceEpaisseurMoyMax")
val6 = rst1("toleranceEpaisseurMax")
val7 = rst1("toleranceDiametreMin")
val8 = rst1("toleranceDiametreMoyMin")
val9 = rst1("toleranceDiametreMoyMax")
val10 = rst1("toleranceDiametreMax")
rst1.Close
Set rst1 = Nothing

Set rst2 = db.OpenRecordset("mesures")
rst2.AddNew
    rst2("aireGaine") = Round(CDec(tab1(3)), 2)
    rst2("excentrement") = Round(CDec(tab1(6)), 2)
    rst2("diametreIntMax") = Round(CDec(tab1(11)), 2)
    rst2("diametreIntMoy") = Round(CDec(tab1(12)), 2)
    rst2("diametreIntMin") = Round(CDec(tab1(13)), 2)
    rst2("diametreOutMax") = Round(CDec(tab1(14)), 2)
    rst2("diametreOutMoy") = Round(CDec(tab1(15)), 2)
    rst2("diametreOutMin") = Round(CDec(tab1(16)), 2)
    rst2("touret") = tab1(21)
    rst2("commande") = tab1(23)
    rst2("machine") = Me.cboMachine
    rst2("operateur") = tab1(25)
    rst2("longueurTouret") = tab1(27)
    rst2("dateMesure") = CDate(tab1(49))
    rst2("ovalite") = CDec(tab1(52))
    rst2("epaisseurMax") = Round(CDec(tab1(62)), 2)
    rst2("epaisseurMoy") = Round(CDec(tab1(63)), 2)
    rst2("epaisseurMin") = Round(CDec(tab1(64)), 2)
    rst2("epaisseur1") = Round(CDec(tab2(0)), 2)
    rst2("epaisseur2") = Round(CDec(tab2(1)), 2)
    rst2("epaisseur3") = Round(CDec(tab2(2)), 2)
    rst2("epaisseur4") = Round(CDec(tab2(3)), 2)
    rst2("epaisseur5") = Round(CDec(tab2(4)), 2)
    rst2("epaisseur6") = Round(CDec(tab2(5)), 2)
    rst2("toleranceEpaisseurMin") = val3
    rst2("toleranceEpaisseurMoyMin") = val4
    rst2("toleranceEpaisseurMoyMax") = val5
    rst2("toleranceEpaisseurMax") = val6
    rst2("toleranceDiametreMin") = val7
    rst2("toleranceDiametreMoyMin") = val8
    rst2("toleranceDiametreMoyMax") = val9
    rst2("toleranceDiametreMax") = val10
rst2.Update
rst2.Close
Set rst2 = Nothing
Set db = Nothing

'Séparation de la date(jj/mm/yyyy) de dateMesure
If Len(Month(CDate(tab1(49)))) = 1 Then
d = Day(CDate(tab1(49))) & "/" & 0 & Month(CDate(tab1(49))) & "/" & Year(CDate(tab1(49)))
Else
d = Day(CDate(tab1(49))) & "/" & Month(CDate(tab1(49))) & "/" & Year(CDate(tab1(49)))
End If
h = Hour(CDate(tab1(49))) & ":" & Minute(CDate(tab1(49))) & ":" & Second(CDate(tab1(49))) 'Séparation de l'heure(hh:mm:ss) de dateMesure

[b]Dim x1 As excel.Application
Dim work As excel.Workbook
Dim wrb As excel.Workbook
Set x1 = New excel.Application
x1.Visible = True
Set wrb = x1.Workbooks.Open(CurrentProject.Path & "\PV_modele.xlsx")  'Démarrer Excel
With wrb.Sheets(1) 'Insertion des valeurs
    .Range("I3").Value = val1 & "-" & val2 'codeProduit + designationProduit
    .Range("H5").Value = d 'date
    .Range("H6").Value = h 'heure
    .Range("H7").Value = tab1(25) 'operateur
    .Range("H8").Value = Me.cboMachine 'machine
    .Range("N5").Value = tab1(21) 'touret
    .Range("N6").Value = tab1(27) 'longueurTouret
    .Range("N7").Value = tab1(23) 'commande
    .Range("C15").Value = Round(CDec(tab1(64)), 2) 'epaisseurMin
    .Range("E15").Value = Round(CDec(tab1(63)), 2) 'epaisseurMoy
    .Range("G15").Value = Round(CDec(tab1(62)), 2) 'epaisseurMax
    .Range("I15").Value = Round(CDec(tab1(16)), 2) 'diametreMin
    .Range("L15").Value = Round(CDec(tab1(15)), 2) 'diametreMoy
    .Range("N15").Value = Round(CDec(tab1(14)), 2) 'diametreMax
    .Range("D15").Value = val3 'toleranceEpaisseurMin
    .Range("F15").Value = val4 'toleranceEpaisseurMoyMin
    .Range("H15").Value = val6 'toleranceEpaisseurMax
    .Range("J15").Value = val7 'toleranceDiametreMin
    .Range("K15").Value = val8 'toleranceDiametreMoyMin
    .Range("M15").Value = val9 'toleranceDiametreMoyMax
    .Range("O15").Value = val10 'toleranceDiametreMax
End With

If CDec(tab1(64)) < val3 Then
wrb.Worksheets(1).Range("C15").Interior.Color = vbGreen
Else
wrb.Worksheets(1).Range("C15").Interior.Color = vbRed
End If

If CDec(tab1(63)) > val4 And CDec(tab1(63)) < val5 Then
wrb.Worksheets(1).Range("E15").Interior.Color = vbGreen
Else
wrb.Worksheets(1).Range("E15").Interior.Color = vbRed
End If

If CDec(tab1(62)) > val6 Then
wrb.Worksheets(1).Range("G15").Interior.Color = vbGreen
Else
wrb.Worksheets(1).Range("G15").Interior.Color = vbRed
End If

If CDec(tab1(16)) < val7 Then
wrb.Worksheets(1).Range("I15").Interior.Color = vbGreen
Else
wrb.Worksheets(1).Range("I15").Interior.Color = vbRed
End If

If CDec(tab1(15)) > val8 And CDec(tab1(15)) < val9 Then
wrb.Worksheets(1).Range("L15").Interior.Color = vbGreen
Else
wrb.Worksheets(1).Range("L15").Interior.Color = vbRed
End If

If CDec(tab1(14)) > val10 Then
wrb.Worksheets(1).Range("N15").Interior.Color = vbGreen
Else
wrb.Worksheets(1).Range("N15").Interior.Color = vbRed
End If

Set wrb = Nothing
Set x1 = Nothing/b
End Sub

Majo64 · Answer

Le classeur ouvert contient-il des macros ? (car si ScreenUpdating à false ...) 

Merci c'était ça.

Modification d'un fichier Excel depuis Access (pas de changement)

4 réponses

Votre réponse

Discussions similaires