Bonjour, je rencontre le bug suivant au 2 ème passage dans une boucle de collection for each .(le 1er passage se passe bien)
Le message d’erreur est un classique
« La méthode ‘Worksheets’ de l’objet global a échoué » .
Sachant aussi que j’aie 3 onglets dans mon fichier excel et que je souhaite faire un 2ème enregistrement dans le 3 ème onglet .Les enregistrements successifs se font de Word vers excel .
Le message d’erreur est un classique
« La méthode ‘Worksheets’ de l’objet global a échoué » .
Sachant aussi que j’aie 3 onglets dans mon fichier excel et que je souhaite faire un 2ème enregistrement dans le 3 ème onglet .Les enregistrements successifs se font de Word vers excel .
Code:
Option Explicit
Public ecrire As Integer
Dim NumomegaBis As String
Public applicationExcel As Excel.Application 'Application Excel
Public classeuretudeCTR As Excel.Workbook 'Classeur Excel
Public feuilleetudeCTR As Excel.Worksheet 'Feuille Excel
Public derlign As Integer
Sub ecriredansetudeCTR()
Dim Numomega As String
Dim nbcarac, nbniveaux As Integer
Set ecrirenbniveaux.applicationExcel = CreateObject("Excel.Application")
Set ecrirenbniveaux.classeuretudeCTR = ecrirenbniveaux.applicationExcel.Workbooks.Open("Y:\documents CTR\SAUVEGARDE ETUDES\ETUDES C.T.R.xls")
Set ecrirenbniveaux.feuilleetudeCTR = ecrirenbniveaux.classeuretudeCTR.Worksheets(1) 'prepare l'ecriture du nb de niveux dans le fichier ETUDE C.T.R
ecrirenbniveaux.applicationExcel.DisplayAlerts = False
compteur1 'lance la fonction compteur
If ecrire = 0 And ActiveCell.Value = "" Then
Niveaux.Show
ecrirenbniveaux.feuilleetudeCTR.Cells(derlign - 1, 3) = NumomegaBis
ecrirenbniveaux.feuilleetudeCTR.Cells(derlign - 1, 2) = ecrireagence
ecrirenbniveaux.feuilleetudeCTR.Cells(derlign - 1, 1) = Date
ecrirenbniveaux.feuilleetudeCTR.Cells(derlign - 1, 7) = "AS"
ecrirenbniveaux.feuilleetudeCTR.Cells(derlign - 1, 4) = "OMEGA"
ecrirenbniveaux.feuilleetudeCTR.Cells(derlign - 1, 5) = Niveaux.TextBox1.Value
Unload Niveaux
End If
If ecrire = 2 And ActiveCell.Value = "" Then
Nbpoutres.Show
ecrirenbniveaux.feuilleetudeCTR.Cells(derlign - 1, 3) = NumomegaBis
ecrirenbniveaux.feuilleetudeCTR.Cells(derlign - 1, 2) = ecrireagence
ecrirenbniveaux.feuilleetudeCTR.Cells(derlign - 1, 1) = Date
ecrirenbniveaux.feuilleetudeCTR.Cells(derlign - 1, 7) = "AS"
ecrirenbniveaux.feuilleetudeCTR.Cells(derlign - 1, 4) = "OMEGA"
'ecrirenbniveaux.feuilleetudeCTR.Cells(derlign - 1, 5) = Niveaux.TextBox1.Value ecrirenbniveaux.feuilleetudeCTR.Cells(derlign - 1, 9) = Nbpoutres.TextBox1.Value
Unload Nbpoutres
End If
ecrirenbniveaux.classeuretudeCTR.Save
ecrirenbniveaux.classeuretudeCTR.Close 'Fermeture du classeur Excel
ecrirenbniveaux.applicationExcel.Quit 'Fermeture de l'application Excel
ecrirenbniveaux.applicationExcel.DisplayAlerts = True
'Désallocation mémoire
Set ecrirenbniveaux.feuilleetudeCTR = Nothing
Set ecrirenbniveaux.classeuretudeCTR = Nothing
Set ecrirenbniveaux.applicationExcel = Nothing
End Sub
Sub compteur1()
Dim Ws As Worksheet 'Ws est une feuille
derlign = 3
ecrire = 0
For Each Ws In Worksheets ‘BUG ICI au 2 ème passage dans la fonction ecriredansetudeCTR
MsgBox (Ws.Name)
If Ws.Name = "ETUDE C.T.R" Then
Sheets("ETUDE C.T.R").Select
Range("A2").Activate 'je demarre à A2 parce que A1 est déjà vide
'tant que la cellule active n'est pas vide
While ActiveCell.Value <> ""
'on descend d'une ligne
ActiveCell.offset(1, 0).Activate
If Cells(derlign, 3) = NumomegaBis
ecrire = 1
End If
derlign = derlign + 1
Wend
End If
If Ws.Name = "STANDARM" And naturepoutre <> "" And sectionbeton <> "" Then
Sheets("STANDARM").Select
Range("A2").Activate
While ActiveCell.Value <> ""
ActiveCell.offset(1, 0).Activate
If Cells(derlign, 3) = NumomegaBis Then
ecrire = 1 'cela n'ecrira rien
Else
ecrire = 2
End If
derlign = derlign + 1
Wend
End If
Next
End Sub
Code:
Sub CommandButton2_Click()
varboucl = 1
Unload VulcainHercule
Call ecrirenbniveaux.ecriredansetudeCTR ‘force le 2 ème passage dans la boucle avec une valeur ecrire = 2 ;cela me permet un 2 ème enregistrement
End Sub
