OVH Cloud OVH Cloud

Requête dans macro VBA Excel

1 réponse
Avatar
dp_favresa
Bonjour,
Nous utilisons un programme spécifique (base de données SQL Server V.8) pour
l'enregistrement de certaines commandes. Ce programme n'est pas disponibles
pour tous les utilisateurs. Pour leur permettre d'accéder au planning des
livraisons, je fais une extraction des données quotidiennes dans un tableau
Excel 2000. Cette extraction est basée sur la date du jour de saisie
introduite dans un formulaire selon le code suivant :

Private Sub CommandButton1_Click()

' ***** DEMANDE L'ACTIVATION DU COMPOSANT MICROSOFT ACTIVEX DATA OBJECT
2.7 LIBRARY
' ***** DEPUIS MENU "OUTILS" - "RÉFÉRENCES"

Dim Cnx As New ADODB.Connection
Dim Rst As New ADODB.Recordset
Dim Année As String * 4
Dim Mois As String * 2
Dim Jour As String * 2
Dim AMJ As String * 8
Dim ValC1 As String * 8
Dim ValC2 As String * 10
Dim Req1 As String
Dim Req2 As String
Dim Compt As Integer
Dim ExtA As String * 4
Dim ExtM As String * 2
Dim ExtJ As String * 2
Dim SurD As String * 3
Année = TextBox1
Mois = TextBox2
Jour = TextBox3
AMJ = Année & Mois & Jour

' ***** INSTRUCTIONS DE SÉLECTION DES CHAMPS ET DE JOINTURE *****
Req1 = "select r.forecaprod, cu.inv_name, c.sit_name, c.sit_town,
a.ct_name, a.ct_town, d.dwgbbsnum, "
Req1 = Req1 & "d.esrc_file, d.rc_num, r.ps_code, r.fabweight,
d.delivstart, r.cust_ref from dwgbbs as d "
Req1 = Req1 & "join ref_ps as r on r.esrc_file = d.esrc_file and
r.rc_num = d.rc_num and r.ps_title = d.dwgbbsnum "
Req1 = Req1 & "join contract as c on c.esrc_file = d.esrc_file and
c.rc_num = d.rc_num "
Req1 = Req1 & "left join contradr as a on a.esrc_file = d.esrc_file and
a.es_num = d.es_num and a.seq_num = r.addr_num "
Req1 = Req1 & "join customer as cu on cu.cust_code = c.cust_code"

' ***** SÉLECTION SELON DATE SAISIE DANS LE FORMULAIRE *****
Req2 = "where d.esrc_file = 'cht05' and d.rc_num <> 5 and r.forecaprod =
" & AMJ
Req1 = Req1 & " " & Req2

' ***** OUVERTURE DE LA BASE *****
Cnx.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Initial
Catalog=Favre;Data Source=Serveur-corc"

' ***** RECHERCHE DE LA DERNIÈRE CELLULE NON VIDE *****
Range("A10000").Select
Selection.End(xlUp).Select

' ***** OUVERTURE DU RECORDSET *****
Rst.Open Req1, Cnx, adOpenKeyset

' ***** COPIE DU RECORDSET DEPUIS LA LIGNE SUIVANTE *****
ActiveCell.Offset(1, 0).CopyFromRecordset Rst

' ***** FERMETURE ET VIDAGE *****
Rst.Close: Set Rst = Nothing
Cnx.Close: Set Cnx = Nothing
Unload UserForm1

' ***** FORMATAGE DES CELLULES DATE *****
Compt = 1
Do Until ActiveCell.Offset(Compt, 0) <> AMJ
ValC2 = Jour & "," & Mois & "," & Année
ActiveCell.Offset(Compt, 0).Value = ValC2
ValC1 = ActiveCell.Offset(Compt, 11).Value
ExtA = Left(ValC1, 4)
ExtM = Right(ValC1, 4)
ExtJ = Right(ValC1, 2)
ValC2 = ExtJ & "," & ExtM & "," & ExtA
ActiveCell.Offset(Compt, 11).Value = ValC2
SurD = ActiveCell.Offset(Compt, 12).Value
If SurD = "S/D" Then
ActiveCell.Offset(Compt, 7).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
ActiveCell.Offset(0, 1).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
ActiveCell.Offset(0, 1).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
ActiveCell.Offset(-Compt, -9).Select
Else
ActiveCell.Offset(Compt, 12).Value = "N"
End If
Compt = Compt + 1
Loop

Application.ScreenUpdating = True
End Sub

Cela fonctionne très bien, mais je ne peux de cette façon mettre à jour
qu'une seule fois en fin de journée, ce qui est insuffisant. Je désire
utiliser un marqueur pour permettre cette mise à jour à la demande.
Le code SQL nécessaire est le suivant :

update dwgbbs set excel_planning = 1
where esrc_file = 'cht05' and nom_champ_à_modifier <> 1 and rc_num <> 5
and inputdate = AMJ

Problème : je n'arrive pas à insérer ce code dans ma macro.
Qui pourrait m'indiquer la façon d'y parvenir ?

Merci d'avance et cordiales salutations.
dp

1 réponse

Avatar
dp_favresa
"dp_favresa" a écrit :

Bonjour,
Nous utilisons un programme spécifique (base de données SQL Server V.8) pour
l'enregistrement de certaines commandes. Ce programme n'est pas disponibles
pour tous les utilisateurs. Pour leur permettre d'accéder au planning des
livraisons, je fais une extraction des données quotidiennes dans un tableau
Excel 2000. Cette extraction est basée sur la date du jour de saisie
introduite dans un formulaire selon le code suivant :

Private Sub CommandButton1_Click()

' ***** DEMANDE L'ACTIVATION DU COMPOSANT MICROSOFT ACTIVEX DATA OBJECT
2.7 LIBRARY
' ***** DEPUIS MENU "OUTILS" - "RÉFÉRENCES"

Dim Cnx As New ADODB.Connection
Dim Rst As New ADODB.Recordset
Dim Année As String * 4
Dim Mois As String * 2
Dim Jour As String * 2
Dim AMJ As String * 8
Dim ValC1 As String * 8
Dim ValC2 As String * 10
Dim Req1 As String
Dim Req2 As String
Dim Compt As Integer
Dim ExtA As String * 4
Dim ExtM As String * 2
Dim ExtJ As String * 2
Dim SurD As String * 3
Année = TextBox1
Mois = TextBox2
Jour = TextBox3
AMJ = Année & Mois & Jour

' ***** INSTRUCTIONS DE SÉLECTION DES CHAMPS ET DE JOINTURE *****
Req1 = "select r.forecaprod, cu.inv_name, c.sit_name, c.sit_town,
a.ct_name, a.ct_town, d.dwgbbsnum, "
Req1 = Req1 & "d.esrc_file, d.rc_num, r.ps_code, r.fabweight,
d.delivstart, r.cust_ref from dwgbbs as d "
Req1 = Req1 & "join ref_ps as r on r.esrc_file = d.esrc_file and
r.rc_num = d.rc_num and r.ps_title = d.dwgbbsnum "
Req1 = Req1 & "join contract as c on c.esrc_file = d.esrc_file and
c.rc_num = d.rc_num "
Req1 = Req1 & "left join contradr as a on a.esrc_file = d.esrc_file and
a.es_num = d.es_num and a.seq_num = r.addr_num "
Req1 = Req1 & "join customer as cu on cu.cust_code = c.cust_code"

' ***** SÉLECTION SELON DATE SAISIE DANS LE FORMULAIRE *****
Req2 = "where d.esrc_file = 'cht05' and d.rc_num <> 5 and r.forecaprod =
" & AMJ
Req1 = Req1 & " " & Req2

' ***** OUVERTURE DE LA BASE *****
Cnx.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Initial
Catalogúvre;Data Source=Serveur-corc"

' ***** RECHERCHE DE LA DERNIÈRE CELLULE NON VIDE *****
Range("A10000").Select
Selection.End(xlUp).Select

' ***** OUVERTURE DU RECORDSET *****
Rst.Open Req1, Cnx, adOpenKeyset

' ***** COPIE DU RECORDSET DEPUIS LA LIGNE SUIVANTE *****
ActiveCell.Offset(1, 0).CopyFromRecordset Rst

' ***** FERMETURE ET VIDAGE *****
Rst.Close: Set Rst = Nothing
Cnx.Close: Set Cnx = Nothing
Unload UserForm1

' ***** FORMATAGE DES CELLULES DATE *****
Compt = 1
Do Until ActiveCell.Offset(Compt, 0) <> AMJ
ValC2 = Jour & "," & Mois & "," & Année
ActiveCell.Offset(Compt, 0).Value = ValC2
ValC1 = ActiveCell.Offset(Compt, 11).Value
ExtA = Left(ValC1, 4)
ExtM = Right(ValC1, 4)
ExtJ = Right(ValC1, 2)
ValC2 = ExtJ & "," & ExtM & "," & ExtA
ActiveCell.Offset(Compt, 11).Value = ValC2
SurD = ActiveCell.Offset(Compt, 12).Value
If SurD = "S/D" Then
ActiveCell.Offset(Compt, 7).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
ActiveCell.Offset(0, 1).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
ActiveCell.Offset(0, 1).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
ActiveCell.Offset(-Compt, -9).Select
Else
ActiveCell.Offset(Compt, 12).Value = "N"
End If
Compt = Compt + 1
Loop

Application.ScreenUpdating = True
End Sub

Cela fonctionne très bien, mais je ne peux de cette façon mettre à jour
qu'une seule fois en fin de journée, ce qui est insuffisant. Je désire
utiliser un marqueur pour permettre cette mise à jour à la demande.
Le code SQL nécessaire est le suivant :

update dwgbbs set excel_planning = 1
where esrc_file = 'cht05' and nom_champ_à_modifier <> 1 and rc_num <> 5
and inputdate = AMJ

Problème : je n'arrive pas à insérer ce code dans ma macro.
Qui pourrait m'indiquer la façon d'y parvenir ?

Merci d'avance et cordiales salutations.
dp



Ajouter ces instructions avant "FERMETURE ET VIDAGE"

' ***** MISE A JOUR DU FLAG *****
Req2 = "update dwgbbs set excel_planning = 1"
Req2 = Req2 & "where esrc_file = 'cht05' and rc_num <> 5 and inputdate =
" & AMJ
Cnx.Execute Req2, adExecuteNoRecords