Problème de macro Excel
Bonjour,
j'ai programmé dans une première feuille excel la saisie d'un login et d'un mot de passe. Quand on clique sur un bouton "valider", une macro va contrôler en base le mot de passe. Si celui-ci est correct , on est dirigé sur une 2ème feuille. Jusqu'ici ça se passe bien. par contre sur la 2ème feuille, je saisie ou modifie des valeurs et je valide par un bouton. Le problème c'est que sur mon pec ça marche , mais par sur un autre pc. Ils ont tous les 2 la meme version de XP (SP2) et la version excel 2003. J'ai mis le niveau de sécurité au plus faible mais rien à faire. quelqu'un a-t-il une idée ?
merci d'avance
Tu dis que ça ne marche pas, mais quel est le problème exactement ?
Cordialement,
salut V_elbie,
effectivement , je crois que c'est pas assez clair.
Sur la 2ème feuille, je saisi des données et le bouton "valider" permet d'enregistrer ces données dans une base de données mysql. Le problème c'est que le bouton "valider" ne s'active pas, et rien n'est mis en base. Comme s'il n'y avait pas de macro derrière ce bouton. Et en plus ça marche sur un poste et pas sur l'autre , les 2 étant équipés de windows XP et excel 2003
@+
je ne suis pas expert en la question, mais peut-être qu'il n'y a effectivement pas la macro sur l'autre pc ?
salut arkana,
non, j'ai vérifié, elle y est bien. Je pense que c'est peut-être un pb de niveau de sécurité (du genre interdiction d'exécution d'une macro pour des raisons de sécurité) , mais j'arrive pas à voir. Peut-être un conflit avec l'antivirus ...
Bonjour,
En 1er, vérifie par click droit sur le bouton que la macro est bien affectée.
Si c'est le cas, place ta macro ou mieux ton fichier pour que l'on puisse contrôler.
Amicalement
Nad
Bonjour,
En plus de ce Nad te dit, j'ai deux questions sur ta demande:
- S'agit-il d'un fichier qui est partagé par deux ordinateurs ou l'utlises-tu une fois sur un PC ou sur l'autre
- Tu parles de base de données msql, es-tu sûr que le PC 2 peut accéder à cette base de données
Donne plus d'explications.
Amicalement
Dan
salut Nad et Dan,
oui la macro est bien affectée.
C'est une macro que j'ai développée sur mon pc (poste de développement) et ensuite je l'ai installée sur un autre poste (on va appeler ce poste "recette" ). donc la feuille et la macro marchent bien sur le poste de développement mais pas sur le poste de recette.
J'ai demandé à ce qu'ils me renvoient la feuille installée sur le poste de recette.
J'ai donc vérifié que la macro est bien affectée.
En ce qui concerne la base mysql, sur le poste de developpement la base est en local sur mon pc (connection odbc)
par contre sur le poste de recette, la base est sur un serveur distant (connection odbc).
C'est l'une des seule différence.
Sinon les 2 postes ont le meme windows (XP SP2) et la meme versikon d'excel (2003).
Peut-être s'agit il d'une interference avec l'antivirus
@+
Karayib
re,
Tu ne peux pas mettre le code ici que l'on voit de quoi il s'agit ?
A te relire
Dan
voici donc le code qui est activé lors du click sur la commandbutton
Private Sub CommandButton1_Click()
Dim cnxOra As ADODB.Connection
Dim resOra As ADODB.Recordset
Dim resMajOra As ADODB.Recordset
Dim resInsOra As ADODB.Recordset
Dim resExcel As ADODB.Recordset
Dim strCell As String
Dim strCell2 As String
Dim iNombre As Integer
Dim iDerniereLigne As Integer
Dim sOuvert As String
Dim iMatricule As Integer
Dim sService As String
Dim sMois As String
Dim sAnnee As String
Dim sRequeteIncident As String
Dim test1 As String
Dim test2 As String
'matricule devra être renseigné par l'écran de d'identification
iMatricule = 1
'iMatricule = ThisWorkbook.Worksheets("Identification").TextBox3.Value
'Service devra être renseigné par l'écran de d'identification
sService = "OB"
'MsgBox "iMatricule : " & iMatricule
sRequeteIncident = "select ANNEE, MOIS, MATINT, SERVICE, CPS, FPS, RPS, PO, ES, ICVP, ISU, ISO, AES, RCP "
sRequeteIncident = sRequeteIncident & "from incidents where MOIS = "
' controles de surface
' connection
Set cnxOra = New ADODB.Connection
'cnxOra.Open "DRIVER={MySQL ODBC 3.51 Driver};SERVER=localhost;DATABASE=chu;UID=root;PWD=;"
cnxOra.Open "DRIVER={MySQL ODBC 3.51 Driver};SERVER=srv-cnv-pdf-01;DATABASE=chu;UID=root;PWD=;"
Set resOra = New ADODB.Recordset
Set resMajOra = New ADODB.Recordset
Set resInsOra = New ADODB.Recordset
Set resExcel = New ADODB.Recordset
resOra.CursorLocation = adUseServer
resMajOra.CursorLocation = adUseServer
resExcel.CursorLocation = adUseServer
resOra.Open "select ANNEE, MOIS from periodes where OUVERT = '1'", cnxOra, adOpenForwardOnly
While resOra.EOF = False
'If resOra(1).Value = "Janvier" Then
'traitement janvier
sAnnee = resOra(0).Value
sMois = resOra(1).Value
resExcel.Open "select CELLULE from incidents_excel where MOIS = '" & sMois & "'", cnxOra, adOpenForwardOnly
resMajOra.Open sRequeteIncident & "'" & sMois & "' and Annee='" & sAnnee & "' and MATINT = " & iMatricule, cnxOra, adOpenKeyset, adLockOptimistic, adCmdText
'resOra.Open "SELECT NUMCLI, NOMSOC FROM clients WHERE NUMCLI ='" & Worksheets("Feuil1").Range(strCell).Value & "'", cnxOra, adOpenKeyset, adLockOptimistic, adCmdText
If resMajOra.EOF = True Then
resMajOra.Close
' insert
resInsOra.Open "incidents ", cnxOra, adOpenKeyset, adLockOptimistic, adCmdTable
resInsOra.AddNew
'Worksheets("TB incidents 2008").Range(strCell).Value = resMajOra(1).Value
resInsOra.Fields("ANNEE") = resOra(0).Value
resInsOra.Fields("MOIS") = resOra(1).Value
resInsOra.Fields("SERVICE") = sService
resInsOra.Fields("MATINT") = iMatricule
'CPS
strCell = resExcel(0).Value + CStr(13)
resInsOra.Fields("CPS") = Worksheets("TB incidents 2008").Range(strCell).Value
'FPS
strCell = resExcel(0).Value + CStr(14)
resInsOra.Fields("FPS") = Worksheets("TB incidents 2008").Range(strCell).Value
'RPS
strCell = resExcel(0).Value + CStr(15)
resInsOra.Fields("RPS") = Worksheets("TB incidents 2008").Range(strCell).Value
'PO
strCell = resExcel(0).Value + CStr(16)
resInsOra.Fields("PO") = Worksheets("TB incidents 2008").Range(strCell).Value
'ES
strCell = resExcel(0).Value + CStr(17)
resInsOra.Fields("ES") = Worksheets("TB incidents 2008").Range(strCell).Value
'ICVP
strCell = resExcel(0).Value + CStr(18)
resInsOra.Fields("ICVP") = Worksheets("TB incidents 2008").Range(strCell).Value
'ISU
strCell = resExcel(0).Value + CStr(19)
resInsOra.Fields("ISU") = Worksheets("TB incidents 2008").Range(strCell).Value
'ISO
strCell = resExcel(0).Value + CStr(20)
resInsOra.Fields("ISO") = Worksheets("TB incidents 2008").Range(strCell).Value
'AES
strCell = resExcel(0).Value + CStr(22)
resInsOra.Fields("AES") = Worksheets("TB incidents 2008").Range(strCell).Value
'RCP
strCell = resExcel(0).Value + CStr(23)
resInsOra.Fields("RCP") = Worksheets("TB incidents 2008").Range(strCell).Value
resInsOra.Update
resInsOra.Close
Else
' CPS
strCell = resExcel(0).Value + CStr(13)
If resMajOra(4).ActualSize = 0 Then
test1 = ""
Else
test1 = resMajOra(4).Value
End If
test2 = Worksheets("TB incidents 2008").Range(strCell).Value
If test1 <> test2 Then
resMajOra.Fields("CPS") = Worksheets("TB incidents 2008").Range(strCell).Value
End If
'Worksheets("TB incidents 2008").Range(strCell).Value = resMajOra(1).Value
' FPS
strCell = resExcel(0).Value + CStr(14)
If resMajOra(5).ActualSize = 0 Then
test1 = ""
Else
test1 = resMajOra(5).Value
End If
test2 = Worksheets("TB incidents 2008").Range(strCell).Value
If test1 <> test2 Then
resMajOra.Fields("FPS") = Worksheets("TB incidents 2008").Range(strCell).Value
End If
'Worksheets("TB incidents 2008").Range(strCell).Value = resMajOra(1).Value
' RPS
strCell = resExcel(0).Value + CStr(15)
If resMajOra(6).ActualSize = 0 Then
test1 = ""
Else
test1 = resMajOra(6).Value
End If
test2 = Worksheets("TB incidents 2008").Range(strCell).Value
If test1 <> test2 Then
resMajOra.Fields("RPS") = Worksheets("TB incidents 2008").Range(strCell).Value
End If
'Worksheets("TB incidents 2008").Range(strCell).Value = resMajOra(1).Value
' PO
strCell = resExcel(0).Value + CStr(16)
If resMajOra(7).ActualSize = 0 Then
test1 = ""
Else
test1 = resMajOra(7).Value
End If
test2 = Worksheets("TB incidents 2008").Range(strCell).Value
If test1 <> test2 Then
resMajOra.Fields("PO") = Worksheets("TB incidents 2008").Range(strCell).Value
End If
'Worksheets("TB incidents 2008").Range(strCell).Value = resMajOra(1).Value
' ES
strCell = resExcel(0).Value + CStr(17)
If resMajOra(8).ActualSize = 0 Then
test1 = ""
Else
test1 = resMajOra(8).Value
End If
test2 = Worksheets("TB incidents 2008").Range(strCell).Value
If test1 <> test2 Then
resMajOra.Fields("ES") = Worksheets("TB incidents 2008").Range(strCell).Value
End If
'Worksheets("TB incidents 2008").Range(strCell).Value = resMajOra(1).Value
' ICVP
strCell = resExcel(0).Value + CStr(18)
If resMajOra(9).ActualSize = 0 Then
test1 = ""
Else
test1 = resMajOra(9).Value
End If
test2 = Worksheets("TB incidents 2008").Range(strCell).Value
If test1 <> test2 Then
resMajOra.Fields("ICVP") = Worksheets("TB incidents 2008").Range(strCell).Value
End If
'Worksheets("TB incidents 2008").Range(strCell).Value = resMajOra(1).Value
' ISU
strCell = resExcel(0).Value + CStr(19)
If resMajOra(10).ActualSize = 0 Then
test1 = ""
Else
test1 = resMajOra(10).Value
End If
test2 = Worksheets("TB incidents 2008").Range(strCell).Value
If test1 <> test2 Then
resMajOra.Fields("ISU") = Worksheets("TB incidents 2008").Range(strCell).Value
End If
'Worksheets("TB incidents 2008").Range(strCell).Value = resMajOra(1).Value
' ISO
strCell = resExcel(0).Value + CStr(20)
If resMajOra(11).ActualSize = 0 Then
test1 = ""
Else
test1 = resMajOra(11).Value
End If
test2 = Worksheets("TB incidents 2008").Range(strCell).Value
If test1 <> test2 Then
resMajOra.Fields("ISO") = Worksheets("TB incidents 2008").Range(strCell).Value
End If
'Worksheets("TB incidents 2008").Range(strCell).Value = resMajOra(1).Value
' AES
strCell = resExcel(0).Value + CStr(22)
If resMajOra(12).ActualSize = 0 Then
test1 = ""
Else
test1 = resMajOra(12).Value
End If
test2 = Worksheets("TB incidents 2008").Range(strCell).Value
If test1 <> test2 Then
resMajOra.Fields("AES") = Worksheets("TB incidents 2008").Range(strCell).Value
End If
'Worksheets("TB incidents 2008").Range(strCell).Value = resMajOra(1).Value
' RCP
strCell = resExcel(0).Value + CStr(23)
If resMajOra(13).ActualSize = 0 Then
test1 = ""
Else
test1 = resMajOra(13).Value
End If
test2 = Worksheets("TB incidents 2008").Range(strCell).Value
If test1 <> test2 Then
resMajOra.Fields("RCP") = Worksheets("TB incidents 2008").Range(strCell).Value
End If
'Worksheets("TB incidents 2008").Range(strCell).Value = resMajOra(1).Value
resMajOra.Update
resMajOra.Close
End If
resExcel.Close
resOra.MoveNext
Wend
resOra.Close
Set cnxOra = Nothing
End Sub
voici le code activé lors de l'affichage de la feuille :
Private Sub Worksheet_Activate()
'CONST COLONNE_LISTE_NOM_CRITERE
Const Janvier = "B"
Const FEVRIER = "C"
Const MARS = "D"
Const AVRIL = "E"
Const MAI = "F"
Const JUIN = "G"
Const JUILLET = "H"
Const AOUT = "I"
Const SEPTEMBRE = "J"
Const OCTOBRE = "K"
Const NOVEMBRE = "L"
Const DECEMBRE = "M"
Const TOTAL = "N"
Dim iIndiceLigne As Integer
Dim cnxOra As ADODB.Connection
Dim resOra As ADODB.Recordset
Dim resMajOra As ADODB.Recordset
Dim resExcel As ADODB.Recordset
Dim strCell As String
Dim strCell2 As String
Dim iNombre As Integer
Dim iDerniereLigne As Integer
Dim sOuvert As String
Dim iMatricule As Integer
Dim sMois As String
Dim sRequeteIncident As String
Dim CelluleOperande As Range
' ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
' Worksheets("TB incidents 2008").Protect Contents:=True, DrawingObjects:=True, Contents:=True, Scenarios:=True
'ActiveSheet.EnableSelection = xlUnlockedCells
'Worksheets("TB incidents 2008").EnableSelection = xllockedCells
'Set CelluleOperande = ActiveCell.Offset(iNumeroLigneCellulePrecedente - ActiveCell.Row, iNumeroColonneCellulePrecedente - ActiveCell.Column + 1)
' CelluleOperande.Locked = True
'matricule devra être renseigné par l'écran de d'identification
' Worksheets("TB incidents 2008").Range("B13").Locked = True
Range("B13:M20").Select
Selection.ClearContents
With Selection.Interior
.ColorIndex = 15
.PatternColorIndex = xlAutomatic
End With
'Range("K26").Select
'ActiveCell.FormulaR1C1 = ""
'Range("H28").Select
'ActiveWindow.LargeScroll ToRight:=-1
Range("B22:M23").Select
Selection.ClearContents
With Selection.Interior
.ColorIndex = 15
.PatternColorIndex = xlAutomatic
End With
iMatricule = 1
sRequeteIncident = "select SERVICE, CPS, FPS, RPS, PO, ES, ICVP, ISU, ISO, AES, RCP "
sRequeteIncident = sRequeteIncident & "from incidents where MOIS = "
' connection
Set cnxOra = New ADODB.Connection
'cnxOra.Open "DRIVER={MySQL ODBC 3.51 Driver};SERVER=localhost;DATABASE=chu;UID=root;PWD=;"
cnxOra.Open "DRIVER={MySQL ODBC 3.51 Driver};SERVER=srv-cnv-pdf-01;DATABASE=chu;UID=root;PWD=;"
Set resOra = New ADODB.Recordset
Set resMajOra = New ADODB.Recordset
Set resExcel = New ADODB.Recordset
resOra.CursorLocation = adUseServer
resMajOra.CursorLocation = adUseServer
resExcel.CursorLocation = adUseServer
resOra.Open "select ANNEE, MOIS from periodes where OUVERT = '1'", cnxOra, adOpenForwardOnly
While resOra.EOF = False
'If resOra(1).Value = "Janvier" Then
'traitement janvier
sMois = resOra(1).Value
resMajOra.Open sRequeteIncident & "'" & sMois & "' and MATINT = " & iMatricule, cnxOra, adOpenForwardOnly
If resMajOra.EOF = False Then
resExcel.Open "select CELLULE from incidents_excel where MOIS = '" & sMois & "'", cnxOra, adOpenForwardOnly
' CPS
strCell = resExcel(0).Value + CStr(13)
Range(strCell).Select
Selection.Interior.ColorIndex = xlNone
Worksheets("TB incidents 2008").Range(strCell).Value = resMajOra(1).Value
' FPS
strCell = resExcel(0).Value + CStr(14)
Range(strCell).Select
Selection.Interior.ColorIndex = xlNone
Worksheets("TB incidents 2008").Range(strCell).Value = resMajOra(2).Value
' RPS
strCell = resExcel(0).Value + CStr(15)
Range(strCell).Select
Selection.Interior.ColorIndex = xlNone
Worksheets("TB incidents 2008").Range(strCell).Value = resMajOra(3).Value
' PO
strCell = resExcel(0).Value + CStr(16)
Range(strCell).Select
Selection.Interior.ColorIndex = xlNone
Worksheets("TB incidents 2008").Range(strCell).Value = resMajOra(4).Value
' ES
strCell = resExcel(0).Value + CStr(17)
Range(strCell).Select
Selection.Interior.ColorIndex = xlNone
Worksheets("TB incidents 2008").Range(strCell).Value = resMajOra(5).Value
' ICVP
strCell = resExcel(0).Value + CStr(18)
Range(strCell).Select
Selection.Interior.ColorIndex = xlNone
Worksheets("TB incidents 2008").Range(strCell).Value = resMajOra(6).Value
' ISU
strCell = resExcel(0).Value + CStr(19)
Range(strCell).Select
Selection.Interior.ColorIndex = xlNone
Worksheets("TB incidents 2008").Range(strCell).Value = resMajOra(7).Value
' ISO
strCell = resExcel(0).Value + CStr(20)
Range(strCell).Select
Selection.Interior.ColorIndex = xlNone
Worksheets("TB incidents 2008").Range(strCell).Value = resMajOra(8).Value
' AES
strCell = resExcel(0).Value + CStr(22)
Range(strCell).Select
Selection.Interior.ColorIndex = xlNone
Worksheets("TB incidents 2008").Range(strCell).Value = resMajOra(9).Value
' RCP
strCell = resExcel(0).Value + CStr(23)
Range(strCell).Select
Selection.Interior.ColorIndex = xlNone
Worksheets("TB incidents 2008").Range(strCell).Value = resMajOra(10).Value
resExcel.Close
End If
resMajOra.Close
' iIndiceLigne = iIndiceLigne + 1
'End If
resOra.MoveNext
Wend
resOra.Close
'Set rcsOra = Nothing
Set cnxOra = Nothing
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
End Sub
merci d'avance