Bonjour,
Je souhaite exporter des données d'un classeur xl vers une base access par
vba, sans avoir à ouvrir cette base. Je dispose d'office2003, je suis d'un
niveau correct en vba, mais je ne maitrise absolument pas les echanges entre
applications, et je ne trouve pas de solution dans l'aide.
merci par avance,
Bonjour,
Je souhaite exporter des données d'un classeur xl vers une base access par
vba, sans avoir à ouvrir cette base. Je dispose d'office2003, je suis d'un
niveau correct en vba, mais je ne maitrise absolument pas les echanges entre
applications, et je ne trouve pas de solution dans l'aide.
merci par avance,
Bonjour,
Je souhaite exporter des données d'un classeur xl vers une base access par
vba, sans avoir à ouvrir cette base. Je dispose d'office2003, je suis d'un
niveau correct en vba, mais je ne maitrise absolument pas les echanges entre
applications, et je ne trouve pas de solution dans l'aide.
merci par avance,
Bonjour Stanislas,
je te laisse te débrouiller avec le code de mon module :
Sache juste que :
- je créee d'abord des fonctions pour vérifier que le fichier excel est
correct
- que la remontée ne va pas pourrir mes tables access (doublons, erreurs, ...)
Enfin, pour comprendre, dans ma base access, deux tables t'intéressent :
- NDF (table des entetes de notes de frais)
- LNDF (table des lignes de notes de frais)
Donc relation de 1 à plusieurs entre NDF et LNDF
Ben bon courage, j'en été à ton point il y a deux mois et je m'en suis sorti
grace au site http://access.developpez.com/faq/ et
http://www.info-3000.com/vbvba/vbainteractionaccess.php principalement.
Astuce : si comme moi tu n'est pas le roi du SQL, tu peux les créer sous
access pour récupérer le bon code émulé (ca, ca va faire gueuler des puristes
à mon avis !!!)
Autre astuce : pour que le code fonctionne, n'oublie pas de cocher les
références ADO, DAO, ou autres sinon tu auras une erreur
Aller, ne te decouraqge surtout pas, c'est pas dur meme si inbuvable au
premier abord.
Philippe.
Function FICHIER_NDF_OK() As Boolean
'1- Vérification bon fichier
'2- Vérification cases remplies
'3- Vérification doublon
'4- Verification paramétrage compte
Application.Calculation = xlCalculationAutomatic
FICHIER_NDF_OK = True
'1- Vérification bon fichier
If ActiveWorkbook.ActiveSheet.Cells(6, 2).Value <> "Version 1.08" Then
Response = MsgBox("Il ne s'agit pas d'un bon fichier ou d'une bonne
version!" & Chr(13) & Chr(13) & "Le programme va s'arrêter.", vbOKOnly +
vbExclamation, "ATTENTION", "", 1000)
FICHIER_NDF_OK = False
Exit Function
End If
'2- Vérifier le décalage des lignes ou des colonnes
If ActiveWorkbook.ActiveSheet.Cells(732, 65).Value <> "MONSIGNET" Then
Response = MsgBox("Des lignes ou des colonnes ont été effacées !" &
Chr(13) & Chr(13) & "Le programme va s'arrêter.", vbOKOnly + vbExclamation,
"ATTENTION", "", 1000)
FICHIER_NDF_OK = False
Exit Function
End If
'3-A Vérification cases remplies
For i = 11 To 16
If ActiveWorkbook.ActiveSheet.Cells(i, 3).Value = "" Then
Response = MsgBox("La cellule qui va être sélectionnée est vide
!" & Chr(13) & Chr(13) & "Le programme va s'arrêter.", vbOKOnly +
vbExclamation, "ATTENTION", "", 1000)
ActiveWorkbook.ActiveSheet.Cells(i, 3).Select
FICHIER_NDF_OK = False
Exit Function
End If
Next
If ActiveWorkbook.ActiveSheet.Cells(11, 5).Value = "" Or
ActiveWorkbook.ActiveSheet.Cells(12, 5).Value = "" Then
Response = MsgBox("La cellule qui va être sélectionnée est vide !" &
Chr(13) & Chr(13) & "Le programme va s'arrêter.", vbOKOnly + vbExclamation,
"ATTENTION", "", 1000)
Range(ActiveWorkbook.ActiveSheet.Cells(5, 5),
ActiveWorkbook.ActiveSheet.Cells(6, 5)).Select
FICHIER_NDF_OK = False
Exit Function
End If
For i = 16 To 25
If ActiveWorkbook.ActiveSheet.Cells(i, 24).Value <> 0 Then
For J = 3 To 6
If ActiveWorkbook.ActiveSheet.Cells(i, J).Value = "" Then
Response = MsgBox("La cellule qui va être sélectionnée
est vide !" & Chr(13) & Chr(13) & "Le programme va s'arrêter.", vbOKOnly +
vbExclamation, "ATTENTION", "", 1000)
ActiveWorkbook.ActiveSheet.Cells(i, J).Select
FICHIER_NDF_OK = False
Exit Function
End If
Next
End If
Next
'3-B Vérification que ce sont bien de chiffres
For i = 16 To 25
If ActiveWorkbook.ActiveSheet.Cells(i, 24).Value <> 0 Then
For J = 8 To 21
If ActiveWorkbook.ActiveSheet.Cells(i, J).Value <> "" Then
If Not IsNumeric(ActiveWorkbook.ActiveSheet.Cells(i,
J).Value) Then
Response = MsgBox("La cellule qui va être
sélectionnée est non numérique !" & Chr(13) & Chr(13) & "Le programme va
s'arrêter.", vbOKOnly + vbExclamation, "ATTENTION", "", 1000)
ActiveWorkbook.ActiveSheet.Cells(i, J).Select
FICHIER_NDF_OK = False
Exit Function
End If
End If
Next
End If
Next
End Function
Function DOUBLON_NDF_OK() As Boolean
DOUBLON_NDF_OK = True
MONACRO = ActiveWorkbook.ActiveSheet.Cells(13, 3).Value
MASEMAINE = ActiveWorkbook.ActiveSheet.Cells(12, 5).Value
MONANNEE = ActiveWorkbook.ActiveSheet.Cells(11, 5).Value
Set BaseSource = DBEngine.Workspaces(0).OpenDatabase("G:Mes
DocumentsTotoAdministratif.mdb")
MySql = "SELECT NDF.ACRO, NDF.SEMAINE, NDF.ANNEE FROM NDF WHERE
(((NDF.ACRO)=""" & MONACRO & """) AND ((NDF.SEMAINE)=" & MASEMAINE & ") AND
((NDF.ANNEE)=" & MONANNEE & "));"
'Mysql = "Select VERIF_ACRO.ACRO From VERIF_ACRO;"
Debug.Print MySql
Set Temp = BaseSource.CreateQueryDef("", MySql)
Set MASELECTION = Temp.OpenRecordset()
If MASELECTION.RecordCount <> 0 Then
DOUBLON_NDF_OK = False
End If
MASELECTION.Close
Temp.Close
Set Temp = Nothing
BaseSource.Close
Set BaseSource = Nothing
End Function
Function COMPTE_PRESENT_NDF_OK() As Boolean
COMPTE_PRESENT_NDF_OK = True
MONACRO = ActiveWorkbook.ActiveSheet.Cells(13, 3).Value
Set BaseSource = DBEngine.Workspaces(0).OpenDatabase("G:Mes
DocumentsTotoAdministratif.mdb")
MySql = "SELECT TOTOS.ACR FROM TOTOS WHERE (((TOTOS.ACR)=""" & MONACRO &
"""));"
Debug.Print MySql
Set Temp = BaseSource.CreateQueryDef("", MySql)
Set MASELECTION = Temp.OpenRecordset()
If MASELECTION.RecordCount = 0 Then
COMPTE_PRESENT_NDF_OK = False
End If
MASELECTION.Close
Temp.Close
Set Temp = Nothing
BaseSource.Close
Set BaseSource = Nothing
End Function
Function COMPTE_PARAMETRE_NDF_OK() As Boolean
COMPTE_PARAMETRE_NDF_OK = True
MONACRO = ActiveWorkbook.ActiveSheet.Cells(13, 3).Value
Set BaseSource = DBEngine.Workspaces(0).OpenDatabase("G:Mes
DocumentsTotoAdministratif.mdb")
MySql = "SELECT TOTOS.ACR, TOTOS.COMPTE FROM TOTOS WHERE
(((TOTOS.ACR)=""" & MONACRO & """) AND ((TOTOS.COMPTE)<>""""));"
Debug.Print MySql
Set Temp = BaseSource.CreateQueryDef("", MySql)
Set MASELECTION = Temp.OpenRecordset()
If MASELECTION.RecordCount = 0 Then
COMPTE_PARAMETRE_NDF_OK = False
End If
MASELECTION.Close
Temp.Close
Set Temp = Nothing
BaseSource.Close
Set BaseSource = Nothing
End Function
Sub REMONTER_NDF()
Dim BaseSource As Database
Dim QueryMag As QueryDef
Dim rstNDF, rstLNDF As Variant
Dim Nom_Magasin, Ville, commercial As String
Dim i As Long
'1- VERIFICATION FICHIER
If FICHIER_NDF_OK = False Then Exit Sub
'2-VERIFICATION NOTE DEJA MONTEE
Rep = vbYes
If DOUBLON_NDF_OK = False Then
Rep = MsgBox("Une note de frais similaire a déjà été montée.
Voulez-vous continuer ?", vbYesNo)
End If
If Rep = vbNo Then
Exit Sub
End If
'3-VERIFICATION COMPTE PRESENT
If COMPTE_PRESENT_NDF_OK = False Then
MsgBox "Le compte n'est pas présent dans la base. La note de frais ne
sera pas montée !"
Exit Sub
End If
'4-VERIFICATION COMPTE PARAMETRE
If COMPTE_PARAMETRE_NDF_OK = False Then
MsgBox "Le compte n'est pas paramétré. La note de frais ne sera pas
montée !"
Exit Sub
End If
'5-DEBUT DE LA REMONTEE
Set BaseSource = DBEngine.Workspaces(0).OpenDatabase("G:Mes
DocumentsTotoAdministratif.mdb")
Set rstNDF = BaseSource.OpenRecordset("NDF", adOpenDynamic,
adLockOptimistic)
If rstNDF.RecordCount = 0 Then
NOUVELID = 1
Else
rstNDF.MoveFirst
MAXID = 0
i = 1
While Not rstNDF.EOF
If rstNDF("ID") > MAXID Then MAXID = rstNDF("ID")
rstNDF.MoveNext
Wend
NOUVELID = MAXID + 1
End If
MONNOM = Cells(11, 3).Value
MONPRENOM = Cells(12, 3).Value
MONACRO = Cells(13, 3).Value
MONEQUIPE = Cells(14, 4).Value
MONANNEE = Cells(11, 5).Value
MASEMAINE = Cells(12, 5).Value
MONPAIEMENT = Cells(15, 3).Value
MADATEREMISE = Cells(16, 3).Value
MONMONTANT = Cells(22, 24).Value
rstNDF.AddNew
rstNDF("ID") = NOUVELID
rstNDF("NOM") = MONNOM
rstNDF("PRENOM") = MONPRENOM
rstNDF("ACRO") = MONACRO
rstNDF("EQUIPE") = MONEQUIPE
rstNDF("ANNEE") = MONANNEE
rstNDF("SEMAINE") = MASEMAINE
rstNDF("PAIEMENT") = MONPAIEMENT
rstNDF("DATE_REMISE") = MADATEREMISE
rstNDF("DATE_REMONTEE") = Date
rstNDF("STATUT") = 1
rstNDF.Update
Bonjour Stanislas,
je te laisse te débrouiller avec le code de mon module :
Sache juste que :
- je créee d'abord des fonctions pour vérifier que le fichier excel est
correct
- que la remontée ne va pas pourrir mes tables access (doublons, erreurs, ...)
Enfin, pour comprendre, dans ma base access, deux tables t'intéressent :
- NDF (table des entetes de notes de frais)
- LNDF (table des lignes de notes de frais)
Donc relation de 1 à plusieurs entre NDF et LNDF
Ben bon courage, j'en été à ton point il y a deux mois et je m'en suis sorti
grace au site http://access.developpez.com/faq/ et
http://www.info-3000.com/vbvba/vbainteractionaccess.php principalement.
Astuce : si comme moi tu n'est pas le roi du SQL, tu peux les créer sous
access pour récupérer le bon code émulé (ca, ca va faire gueuler des puristes
à mon avis !!!)
Autre astuce : pour que le code fonctionne, n'oublie pas de cocher les
références ADO, DAO, ou autres sinon tu auras une erreur
Aller, ne te decouraqge surtout pas, c'est pas dur meme si inbuvable au
premier abord.
Philippe.
Function FICHIER_NDF_OK() As Boolean
'1- Vérification bon fichier
'2- Vérification cases remplies
'3- Vérification doublon
'4- Verification paramétrage compte
Application.Calculation = xlCalculationAutomatic
FICHIER_NDF_OK = True
'1- Vérification bon fichier
If ActiveWorkbook.ActiveSheet.Cells(6, 2).Value <> "Version 1.08" Then
Response = MsgBox("Il ne s'agit pas d'un bon fichier ou d'une bonne
version!" & Chr(13) & Chr(13) & "Le programme va s'arrêter.", vbOKOnly +
vbExclamation, "ATTENTION", "", 1000)
FICHIER_NDF_OK = False
Exit Function
End If
'2- Vérifier le décalage des lignes ou des colonnes
If ActiveWorkbook.ActiveSheet.Cells(732, 65).Value <> "MONSIGNET" Then
Response = MsgBox("Des lignes ou des colonnes ont été effacées !" &
Chr(13) & Chr(13) & "Le programme va s'arrêter.", vbOKOnly + vbExclamation,
"ATTENTION", "", 1000)
FICHIER_NDF_OK = False
Exit Function
End If
'3-A Vérification cases remplies
For i = 11 To 16
If ActiveWorkbook.ActiveSheet.Cells(i, 3).Value = "" Then
Response = MsgBox("La cellule qui va être sélectionnée est vide
!" & Chr(13) & Chr(13) & "Le programme va s'arrêter.", vbOKOnly +
vbExclamation, "ATTENTION", "", 1000)
ActiveWorkbook.ActiveSheet.Cells(i, 3).Select
FICHIER_NDF_OK = False
Exit Function
End If
Next
If ActiveWorkbook.ActiveSheet.Cells(11, 5).Value = "" Or
ActiveWorkbook.ActiveSheet.Cells(12, 5).Value = "" Then
Response = MsgBox("La cellule qui va être sélectionnée est vide !" &
Chr(13) & Chr(13) & "Le programme va s'arrêter.", vbOKOnly + vbExclamation,
"ATTENTION", "", 1000)
Range(ActiveWorkbook.ActiveSheet.Cells(5, 5),
ActiveWorkbook.ActiveSheet.Cells(6, 5)).Select
FICHIER_NDF_OK = False
Exit Function
End If
For i = 16 To 25
If ActiveWorkbook.ActiveSheet.Cells(i, 24).Value <> 0 Then
For J = 3 To 6
If ActiveWorkbook.ActiveSheet.Cells(i, J).Value = "" Then
Response = MsgBox("La cellule qui va être sélectionnée
est vide !" & Chr(13) & Chr(13) & "Le programme va s'arrêter.", vbOKOnly +
vbExclamation, "ATTENTION", "", 1000)
ActiveWorkbook.ActiveSheet.Cells(i, J).Select
FICHIER_NDF_OK = False
Exit Function
End If
Next
End If
Next
'3-B Vérification que ce sont bien de chiffres
For i = 16 To 25
If ActiveWorkbook.ActiveSheet.Cells(i, 24).Value <> 0 Then
For J = 8 To 21
If ActiveWorkbook.ActiveSheet.Cells(i, J).Value <> "" Then
If Not IsNumeric(ActiveWorkbook.ActiveSheet.Cells(i,
J).Value) Then
Response = MsgBox("La cellule qui va être
sélectionnée est non numérique !" & Chr(13) & Chr(13) & "Le programme va
s'arrêter.", vbOKOnly + vbExclamation, "ATTENTION", "", 1000)
ActiveWorkbook.ActiveSheet.Cells(i, J).Select
FICHIER_NDF_OK = False
Exit Function
End If
End If
Next
End If
Next
End Function
Function DOUBLON_NDF_OK() As Boolean
DOUBLON_NDF_OK = True
MONACRO = ActiveWorkbook.ActiveSheet.Cells(13, 3).Value
MASEMAINE = ActiveWorkbook.ActiveSheet.Cells(12, 5).Value
MONANNEE = ActiveWorkbook.ActiveSheet.Cells(11, 5).Value
Set BaseSource = DBEngine.Workspaces(0).OpenDatabase("G:Mes
DocumentsTotoAdministratif.mdb")
MySql = "SELECT NDF.ACRO, NDF.SEMAINE, NDF.ANNEE FROM NDF WHERE
(((NDF.ACRO)=""" & MONACRO & """) AND ((NDF.SEMAINE)=" & MASEMAINE & ") AND
((NDF.ANNEE)=" & MONANNEE & "));"
'Mysql = "Select VERIF_ACRO.ACRO From VERIF_ACRO;"
Debug.Print MySql
Set Temp = BaseSource.CreateQueryDef("", MySql)
Set MASELECTION = Temp.OpenRecordset()
If MASELECTION.RecordCount <> 0 Then
DOUBLON_NDF_OK = False
End If
MASELECTION.Close
Temp.Close
Set Temp = Nothing
BaseSource.Close
Set BaseSource = Nothing
End Function
Function COMPTE_PRESENT_NDF_OK() As Boolean
COMPTE_PRESENT_NDF_OK = True
MONACRO = ActiveWorkbook.ActiveSheet.Cells(13, 3).Value
Set BaseSource = DBEngine.Workspaces(0).OpenDatabase("G:Mes
DocumentsTotoAdministratif.mdb")
MySql = "SELECT TOTOS.ACR FROM TOTOS WHERE (((TOTOS.ACR)=""" & MONACRO &
"""));"
Debug.Print MySql
Set Temp = BaseSource.CreateQueryDef("", MySql)
Set MASELECTION = Temp.OpenRecordset()
If MASELECTION.RecordCount = 0 Then
COMPTE_PRESENT_NDF_OK = False
End If
MASELECTION.Close
Temp.Close
Set Temp = Nothing
BaseSource.Close
Set BaseSource = Nothing
End Function
Function COMPTE_PARAMETRE_NDF_OK() As Boolean
COMPTE_PARAMETRE_NDF_OK = True
MONACRO = ActiveWorkbook.ActiveSheet.Cells(13, 3).Value
Set BaseSource = DBEngine.Workspaces(0).OpenDatabase("G:Mes
DocumentsTotoAdministratif.mdb")
MySql = "SELECT TOTOS.ACR, TOTOS.COMPTE FROM TOTOS WHERE
(((TOTOS.ACR)=""" & MONACRO & """) AND ((TOTOS.COMPTE)<>""""));"
Debug.Print MySql
Set Temp = BaseSource.CreateQueryDef("", MySql)
Set MASELECTION = Temp.OpenRecordset()
If MASELECTION.RecordCount = 0 Then
COMPTE_PARAMETRE_NDF_OK = False
End If
MASELECTION.Close
Temp.Close
Set Temp = Nothing
BaseSource.Close
Set BaseSource = Nothing
End Function
Sub REMONTER_NDF()
Dim BaseSource As Database
Dim QueryMag As QueryDef
Dim rstNDF, rstLNDF As Variant
Dim Nom_Magasin, Ville, commercial As String
Dim i As Long
'1- VERIFICATION FICHIER
If FICHIER_NDF_OK = False Then Exit Sub
'2-VERIFICATION NOTE DEJA MONTEE
Rep = vbYes
If DOUBLON_NDF_OK = False Then
Rep = MsgBox("Une note de frais similaire a déjà été montée.
Voulez-vous continuer ?", vbYesNo)
End If
If Rep = vbNo Then
Exit Sub
End If
'3-VERIFICATION COMPTE PRESENT
If COMPTE_PRESENT_NDF_OK = False Then
MsgBox "Le compte n'est pas présent dans la base. La note de frais ne
sera pas montée !"
Exit Sub
End If
'4-VERIFICATION COMPTE PARAMETRE
If COMPTE_PARAMETRE_NDF_OK = False Then
MsgBox "Le compte n'est pas paramétré. La note de frais ne sera pas
montée !"
Exit Sub
End If
'5-DEBUT DE LA REMONTEE
Set BaseSource = DBEngine.Workspaces(0).OpenDatabase("G:Mes
DocumentsTotoAdministratif.mdb")
Set rstNDF = BaseSource.OpenRecordset("NDF", adOpenDynamic,
adLockOptimistic)
If rstNDF.RecordCount = 0 Then
NOUVELID = 1
Else
rstNDF.MoveFirst
MAXID = 0
i = 1
While Not rstNDF.EOF
If rstNDF("ID") > MAXID Then MAXID = rstNDF("ID")
rstNDF.MoveNext
Wend
NOUVELID = MAXID + 1
End If
MONNOM = Cells(11, 3).Value
MONPRENOM = Cells(12, 3).Value
MONACRO = Cells(13, 3).Value
MONEQUIPE = Cells(14, 4).Value
MONANNEE = Cells(11, 5).Value
MASEMAINE = Cells(12, 5).Value
MONPAIEMENT = Cells(15, 3).Value
MADATEREMISE = Cells(16, 3).Value
MONMONTANT = Cells(22, 24).Value
rstNDF.AddNew
rstNDF("ID") = NOUVELID
rstNDF("NOM") = MONNOM
rstNDF("PRENOM") = MONPRENOM
rstNDF("ACRO") = MONACRO
rstNDF("EQUIPE") = MONEQUIPE
rstNDF("ANNEE") = MONANNEE
rstNDF("SEMAINE") = MASEMAINE
rstNDF("PAIEMENT") = MONPAIEMENT
rstNDF("DATE_REMISE") = MADATEREMISE
rstNDF("DATE_REMONTEE") = Date
rstNDF("STATUT") = 1
rstNDF.Update
Bonjour Stanislas,
je te laisse te débrouiller avec le code de mon module :
Sache juste que :
- je créee d'abord des fonctions pour vérifier que le fichier excel est
correct
- que la remontée ne va pas pourrir mes tables access (doublons, erreurs, ...)
Enfin, pour comprendre, dans ma base access, deux tables t'intéressent :
- NDF (table des entetes de notes de frais)
- LNDF (table des lignes de notes de frais)
Donc relation de 1 à plusieurs entre NDF et LNDF
Ben bon courage, j'en été à ton point il y a deux mois et je m'en suis sorti
grace au site http://access.developpez.com/faq/ et
http://www.info-3000.com/vbvba/vbainteractionaccess.php principalement.
Astuce : si comme moi tu n'est pas le roi du SQL, tu peux les créer sous
access pour récupérer le bon code émulé (ca, ca va faire gueuler des puristes
à mon avis !!!)
Autre astuce : pour que le code fonctionne, n'oublie pas de cocher les
références ADO, DAO, ou autres sinon tu auras une erreur
Aller, ne te decouraqge surtout pas, c'est pas dur meme si inbuvable au
premier abord.
Philippe.
Function FICHIER_NDF_OK() As Boolean
'1- Vérification bon fichier
'2- Vérification cases remplies
'3- Vérification doublon
'4- Verification paramétrage compte
Application.Calculation = xlCalculationAutomatic
FICHIER_NDF_OK = True
'1- Vérification bon fichier
If ActiveWorkbook.ActiveSheet.Cells(6, 2).Value <> "Version 1.08" Then
Response = MsgBox("Il ne s'agit pas d'un bon fichier ou d'une bonne
version!" & Chr(13) & Chr(13) & "Le programme va s'arrêter.", vbOKOnly +
vbExclamation, "ATTENTION", "", 1000)
FICHIER_NDF_OK = False
Exit Function
End If
'2- Vérifier le décalage des lignes ou des colonnes
If ActiveWorkbook.ActiveSheet.Cells(732, 65).Value <> "MONSIGNET" Then
Response = MsgBox("Des lignes ou des colonnes ont été effacées !" &
Chr(13) & Chr(13) & "Le programme va s'arrêter.", vbOKOnly + vbExclamation,
"ATTENTION", "", 1000)
FICHIER_NDF_OK = False
Exit Function
End If
'3-A Vérification cases remplies
For i = 11 To 16
If ActiveWorkbook.ActiveSheet.Cells(i, 3).Value = "" Then
Response = MsgBox("La cellule qui va être sélectionnée est vide
!" & Chr(13) & Chr(13) & "Le programme va s'arrêter.", vbOKOnly +
vbExclamation, "ATTENTION", "", 1000)
ActiveWorkbook.ActiveSheet.Cells(i, 3).Select
FICHIER_NDF_OK = False
Exit Function
End If
Next
If ActiveWorkbook.ActiveSheet.Cells(11, 5).Value = "" Or
ActiveWorkbook.ActiveSheet.Cells(12, 5).Value = "" Then
Response = MsgBox("La cellule qui va être sélectionnée est vide !" &
Chr(13) & Chr(13) & "Le programme va s'arrêter.", vbOKOnly + vbExclamation,
"ATTENTION", "", 1000)
Range(ActiveWorkbook.ActiveSheet.Cells(5, 5),
ActiveWorkbook.ActiveSheet.Cells(6, 5)).Select
FICHIER_NDF_OK = False
Exit Function
End If
For i = 16 To 25
If ActiveWorkbook.ActiveSheet.Cells(i, 24).Value <> 0 Then
For J = 3 To 6
If ActiveWorkbook.ActiveSheet.Cells(i, J).Value = "" Then
Response = MsgBox("La cellule qui va être sélectionnée
est vide !" & Chr(13) & Chr(13) & "Le programme va s'arrêter.", vbOKOnly +
vbExclamation, "ATTENTION", "", 1000)
ActiveWorkbook.ActiveSheet.Cells(i, J).Select
FICHIER_NDF_OK = False
Exit Function
End If
Next
End If
Next
'3-B Vérification que ce sont bien de chiffres
For i = 16 To 25
If ActiveWorkbook.ActiveSheet.Cells(i, 24).Value <> 0 Then
For J = 8 To 21
If ActiveWorkbook.ActiveSheet.Cells(i, J).Value <> "" Then
If Not IsNumeric(ActiveWorkbook.ActiveSheet.Cells(i,
J).Value) Then
Response = MsgBox("La cellule qui va être
sélectionnée est non numérique !" & Chr(13) & Chr(13) & "Le programme va
s'arrêter.", vbOKOnly + vbExclamation, "ATTENTION", "", 1000)
ActiveWorkbook.ActiveSheet.Cells(i, J).Select
FICHIER_NDF_OK = False
Exit Function
End If
End If
Next
End If
Next
End Function
Function DOUBLON_NDF_OK() As Boolean
DOUBLON_NDF_OK = True
MONACRO = ActiveWorkbook.ActiveSheet.Cells(13, 3).Value
MASEMAINE = ActiveWorkbook.ActiveSheet.Cells(12, 5).Value
MONANNEE = ActiveWorkbook.ActiveSheet.Cells(11, 5).Value
Set BaseSource = DBEngine.Workspaces(0).OpenDatabase("G:Mes
DocumentsTotoAdministratif.mdb")
MySql = "SELECT NDF.ACRO, NDF.SEMAINE, NDF.ANNEE FROM NDF WHERE
(((NDF.ACRO)=""" & MONACRO & """) AND ((NDF.SEMAINE)=" & MASEMAINE & ") AND
((NDF.ANNEE)=" & MONANNEE & "));"
'Mysql = "Select VERIF_ACRO.ACRO From VERIF_ACRO;"
Debug.Print MySql
Set Temp = BaseSource.CreateQueryDef("", MySql)
Set MASELECTION = Temp.OpenRecordset()
If MASELECTION.RecordCount <> 0 Then
DOUBLON_NDF_OK = False
End If
MASELECTION.Close
Temp.Close
Set Temp = Nothing
BaseSource.Close
Set BaseSource = Nothing
End Function
Function COMPTE_PRESENT_NDF_OK() As Boolean
COMPTE_PRESENT_NDF_OK = True
MONACRO = ActiveWorkbook.ActiveSheet.Cells(13, 3).Value
Set BaseSource = DBEngine.Workspaces(0).OpenDatabase("G:Mes
DocumentsTotoAdministratif.mdb")
MySql = "SELECT TOTOS.ACR FROM TOTOS WHERE (((TOTOS.ACR)=""" & MONACRO &
"""));"
Debug.Print MySql
Set Temp = BaseSource.CreateQueryDef("", MySql)
Set MASELECTION = Temp.OpenRecordset()
If MASELECTION.RecordCount = 0 Then
COMPTE_PRESENT_NDF_OK = False
End If
MASELECTION.Close
Temp.Close
Set Temp = Nothing
BaseSource.Close
Set BaseSource = Nothing
End Function
Function COMPTE_PARAMETRE_NDF_OK() As Boolean
COMPTE_PARAMETRE_NDF_OK = True
MONACRO = ActiveWorkbook.ActiveSheet.Cells(13, 3).Value
Set BaseSource = DBEngine.Workspaces(0).OpenDatabase("G:Mes
DocumentsTotoAdministratif.mdb")
MySql = "SELECT TOTOS.ACR, TOTOS.COMPTE FROM TOTOS WHERE
(((TOTOS.ACR)=""" & MONACRO & """) AND ((TOTOS.COMPTE)<>""""));"
Debug.Print MySql
Set Temp = BaseSource.CreateQueryDef("", MySql)
Set MASELECTION = Temp.OpenRecordset()
If MASELECTION.RecordCount = 0 Then
COMPTE_PARAMETRE_NDF_OK = False
End If
MASELECTION.Close
Temp.Close
Set Temp = Nothing
BaseSource.Close
Set BaseSource = Nothing
End Function
Sub REMONTER_NDF()
Dim BaseSource As Database
Dim QueryMag As QueryDef
Dim rstNDF, rstLNDF As Variant
Dim Nom_Magasin, Ville, commercial As String
Dim i As Long
'1- VERIFICATION FICHIER
If FICHIER_NDF_OK = False Then Exit Sub
'2-VERIFICATION NOTE DEJA MONTEE
Rep = vbYes
If DOUBLON_NDF_OK = False Then
Rep = MsgBox("Une note de frais similaire a déjà été montée.
Voulez-vous continuer ?", vbYesNo)
End If
If Rep = vbNo Then
Exit Sub
End If
'3-VERIFICATION COMPTE PRESENT
If COMPTE_PRESENT_NDF_OK = False Then
MsgBox "Le compte n'est pas présent dans la base. La note de frais ne
sera pas montée !"
Exit Sub
End If
'4-VERIFICATION COMPTE PARAMETRE
If COMPTE_PARAMETRE_NDF_OK = False Then
MsgBox "Le compte n'est pas paramétré. La note de frais ne sera pas
montée !"
Exit Sub
End If
'5-DEBUT DE LA REMONTEE
Set BaseSource = DBEngine.Workspaces(0).OpenDatabase("G:Mes
DocumentsTotoAdministratif.mdb")
Set rstNDF = BaseSource.OpenRecordset("NDF", adOpenDynamic,
adLockOptimistic)
If rstNDF.RecordCount = 0 Then
NOUVELID = 1
Else
rstNDF.MoveFirst
MAXID = 0
i = 1
While Not rstNDF.EOF
If rstNDF("ID") > MAXID Then MAXID = rstNDF("ID")
rstNDF.MoveNext
Wend
NOUVELID = MAXID + 1
End If
MONNOM = Cells(11, 3).Value
MONPRENOM = Cells(12, 3).Value
MONACRO = Cells(13, 3).Value
MONEQUIPE = Cells(14, 4).Value
MONANNEE = Cells(11, 5).Value
MASEMAINE = Cells(12, 5).Value
MONPAIEMENT = Cells(15, 3).Value
MADATEREMISE = Cells(16, 3).Value
MONMONTANT = Cells(22, 24).Value
rstNDF.AddNew
rstNDF("ID") = NOUVELID
rstNDF("NOM") = MONNOM
rstNDF("PRENOM") = MONPRENOM
rstNDF("ACRO") = MONACRO
rstNDF("EQUIPE") = MONEQUIPE
rstNDF("ANNEE") = MONANNEE
rstNDF("SEMAINE") = MASEMAINE
rstNDF("PAIEMENT") = MONPAIEMENT
rstNDF("DATE_REMISE") = MADATEREMISE
rstNDF("DATE_REMONTEE") = Date
rstNDF("STATUT") = 1
rstNDF.Update