begin process at 2013 05 22 11:08:50
  Trouver un code source :
 
dans
 
[ Dernières recherches ]
Accueil > Forum > 

Visual Basic 6

 > 

Langages dérivés

 > 

VBA

 > 

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

Derniers messages déposésPoser une question dans le forum ou lancer une discussion

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

jeudi 7 mars 2013 à 15:22:10 | Modification d'un fichier Excel depuis Access (pas de changement)

Majo64
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.

Code Visual Basic :
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
jeudi 7 mars 2013 à 16:32:47 | Re : Modification d'un fichier Excel depuis Access (pas de changement)

lolokun

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..
vendredi 8 mars 2013 à 09:55:03 | Re : Modification d'un fichier Excel depuis Access (pas de changement)

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

Code Visual Basic :
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
vendredi 8 mars 2013 à 10:25:13 | Re : Modification d'un fichier Excel depuis Access (pas de changement)

ucfoutu

Membre Club
Réponse acceptée !
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.
jeudi 14 mars 2013 à 09:17:18 | Re : Modification d'un fichier Excel depuis Access (pas de changement)

Majo64

Le classeur ouvert contient-il des macros ? (car si ScreenUpdating à false ...)



Merci c'était ça.


Cette discussion est classée dans : excel, x1, value, range, tab1

Répondre à ce message

Sujets en rapport avec ce message

importer les dannées dans Excel à partir de VB6 [ par Claudehippolyte ] bonsoir, j'ai une erreur lorsque je tentes d'importer les données à partir de vb6 pour excel. L'érreur qui apparît est le suivant: type definir par l' [Catégorie modifiée VB6 --> VBA] Remplir une feuil Excel a partir d'une BD [ par devilmks ] Bonjour ! je suis entrain de faire une ptite application , et j'ai une bouton qui permet d'afficher un classeur excel ... la feuil(excel) sera rempli Copier coller tableau d'excel à Powerpoint [ par Raitensama95 ] Bonsoir J'ai un problème avec mon code VBA. Je cherche à faire évoluer dynamiquement un tableau Excel et le coller dans une présentation existante Pow couleur du texte dans cases excel [ par joina ] je sais que cette question a déja été posée mais je n'ai trouvé aucune reponse satisfaisante pour VB. Ca c'est mes cases :A_EXCEL.Worksheets(1).Range( Coller une feuille EXCEL dans une OLE [ par Caussenard ] Bonjour,Je suis en train de develloper un programme qui enregistre des informations dans un feuille excel, et j'aimerai afficher cette feuille dans mo Visual Basic - Appliquer la même macro à plusieurs colonnnes sur excel [ par nobilis ] Bonjour,J'ai développé un début de macro sur excel avec le Visual Basic Editor.Elle fonctionne très bien sur la première colonne (colonne D dans excel format Textbox [ par olivierk ] Bonjour,J'ai un userform avec des textbox. Les textbox vont chercher des valeur sur une feuille excel. Mais sur excel 2000. J'ai un message d'erreur q Suppression d'une ligne de données Excel [ par benito28 ] Bonjour, je suis en grande situation désespéré. lol! En fait je suis en pleine création d'un logiciel de gestion des stocks ( usage personnel ). Mon p Paramétrer le nom d'une Progress Bar sous Excel 2003 [ par mrpommy ] Bonjour à tous,Je pratique le VBA sous Excel 2003 depuis quelques mois seulement et je m'exalte devant les possibilités ouvertes par les communication boucles imbriquées dans vba pour excel [ par chaudier37 ] bonjourje travaille dans excel, j'ai un tableau avec des deviss et je dois remplir le tableau avec un imputbox. je tente de faire une boucle pour m'ev


Nos sponsors


Appels d'offres

Sondage...

CalendriCode

Mai 2013
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
2728293031  

Consulter la suite du CalendriCode

Photothèque

Photo Beauty meadow. Abstract summer landscape for your designPhoto Rhodes 5
Photo Winter an der Nordsee, Juist, Dünen im Abendlicht 

Visiter la photothèque

A découvrir
 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 3,026 sec (3)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales
Outils Convertisseur VB/C# Snippets et scripts Outils en ligne La ToolBox
Communauté Programmation Photographie Technologie Newsgroups Emploi Forum Blogs
Guide d'achat Téléphonie mobile Image et son Informatique Bureautique Jeux vidéo
Logiciels Internet & Réseau Développement Market Android Jeux & Loisirs Graphisme Multimédia Sécurité Pilotes
Loisirs Cartes virtuelles Vidéos droles Jeux en ligne Géoguide AndroLib [FR] AndroLib [US] FormidApps [FR] FormidApps [US]