Discussion :

[nyepalo]

Bonjour Tous,

Je viens par cette nouvelle discussion solliciter votre expertise à l'effet de revoir mon code ci-joint. Je m'explique
La codification de nos immobilisations obéit à plusieurs critères dont le site et oblige une transformation du code barre de chaque immo selon son site.
Serait-il possible de faire la transformation du code et un update après transformation si condition remplie suivant la règle ci-dessous et uniquement sur le champ codbarreimmo :

Si longueur (Codbarreimmo) = 25 caractères et si les 5 premiers caractères de Codbarreimmo ="10029" Alors,
on transforme le contenu de Codbarreimmo
Codbarreimmo = Mid(Codbarreimmo, 3) & Mid(Codbarreimmo, 11, 3) & "26" & Mid(Codbarreimmo, 14, 8)
c’est-à-dire 3 dernières positions du code + 3 premières positions (sur 11) du code + 26 + 8 dernières positions du code.

Sinon, pas de transformation, c’est-à-dire le code reste inchangé
Fin,

Un essaie de code qui ne fait satisfait pas mes attentes. Je sollicite donc l'aide des inspirés

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub Convert_CodeBarre()
Dim iRst As DAO.Recordset
Dim iDb As DAO.Database
Dim RefA As String
Dim RefB As String
 
 
Set iDb = CurrentDb
Set iRst = iDb.OpenRecordset("Tbl_Immo", dbOpenTable)
 
While Not iRst.EOF
  'Passe en mode modification
  iRst.Edit
  'Affecte la valeur actuelle du champ à RefA
  RefA = iRst.Fields("Codbarreimmo").Value
    If Len(RefA) = 25 Then
        If Left(RefA, 5) = "29100" Then
            RefB = Mid(RefA, 8, 3) & Mid(RefA, 11, 3) & "29" & Mid(RefA, 14, 8)
        Else
            RefB = RefA
            iRst.Update
        End If
 
    End If
    'Passe au suivant
    iRst.MoveNext
Wend
 
'Libération des objets
iRst.Close
iDb.Close
Set iRst = Nothing
Set iDb = Nothing
End Sub

Bien à vous.

[marot_r]

Bonjour.

Un essaie de code qui ne fait satisfait pas mes attentes.

Quelles sont les attentes qui ne sont pas satisfaites ? Le code à l'air de faire ce dont tu as besoin.

A+

[nyepalo]

Bonjour marot_r,

Merci pour votre réaction,
Mes attentes :
parcourir la table et transformer les codes dont la longueur est égale à 25 caractères et dont les 5 premiers caractères sont "10029".
Faire la mise à jour du code correspondant aux critères.
Laisser tel quel les codes dont les 5 premiers caractères sont différents "10029"

Par exemple :
Code barre initial : 1002900000123456789000555 doit devenir après transformation : 0001232645678900.
Or l'exécution de mon code ne produit aucune transformation quand bien même les critères sont remplis. Je joins ma table test.

Merci.

[madefemere]

Bonjour,

Et comme cela ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub Convert_CodeBarre()
Dim iRst As DAO.Recordset
Dim iDb As DAO.Database
Dim RefA As String
Dim RefB As String
 
Set iDb = CurrentDb
Set iRst = iDb.OpenRecordset("Tbl_Immo", dbOpenTable)
 
While Not iRst.EOF
  'Affecte la valeur actuelle du champ à RefA
  RefA = iRst.Fields("Codbarreimmo").Value
    ' si la longueur est égale à 25 caractères et dont les 5 premiers caractères sont "10029". 
    If Len(RefA) = 25 AND Left(RefA, 5) = "29100" Then
            'Passe en mode modification
            iRst.Edit
            RefB = Mid(RefA, 8, 3) & Mid(RefA, 11, 3) & "29" & Mid(RefA, 14, 8)
            iRst.UpDate
        Else   ' séquence inutile à mon avis vu que pas de changement
            iRst.Edit
            RefB = RefA
            iRst.Update
    End If
    'Passe au suivant
    iRst.MoveNext
Wend
 
'Libération des objets
iRst.Close
iDb.Close
Set iRst = Nothing
Set iDb = Nothing
End Sub

Cordialement,

[nyepalo]

Bonjour madefemere,

Rien n'y fait, pas de mise à jour de code dans la table immo

Merci.

[marot_r]

Juste une instruction mal placée.

Ci dessous la correction en rouge.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Sub Convert_CodeBarre()
Dim iRst As DAO.Recordset
Dim iDb As DAO.Database
Dim RefA As String
Dim RefB As String
 
 
Set iDb = CurrentDb
Set iRst = iDb.OpenRecordset("Tbl_Immo", dbOpenTable)
 
While Not iRst.EOF
  'Passe en mode modification
  iRst.Edit
  'Affecte la valeur actuelle du champ à RefA
  RefA = iRst.Fields("Codbarreimmo").Value
    If Len(RefA) = 25 Then
        If Left(RefA, 5) = "29100" Then
            RefB = Mid(RefA, 8, 3) & Mid(RefA, 11, 3) & "29" & Mid(RefA, 14, 8)
        Else
            RefB = RefA
        End If

    End If
        iRst.Update

    'Passe au suivant
    iRst.MoveNext
Wend
 
'Libération des objets
iRst.Close
iDb.Close
Set iRst = Nothing
Set iDb = Nothing
End Sub

[nyepalo]

Après avoir déroulé pas à pas les codes proposés, a mon avis le problème est ailleurs l'algorithme est visiblement correct mais la mise à jour ne s'effectue pas dans la table. Bizarre !

Merci encore.

[nyepalo]

Bonjour les amis,

J'ai finalement trouvé la bonne solution je pense à mon problème. En passant par une requête mise à jour :

UPDATE Tbl_Immo SET Codbarreimmo = Mid(Codbarreimmo, 8, 3) & Mid(Codbarreimmo, 11, 3) & "29" & Mid(Codbarreimmo, 14, 8)
WHERE Len(Codbarreimmo) = 25 And Left(Codbarreimmo,5) = "29100";

Peut-être qu'il y a mieux, en tout cas, je demeure preneur de vos solutions.

Merci encore à tous.

[nyepalo]

Bonjour à tous,

A force d'appuyer sur on fini par trouver. Eh bien, j'ai finalement trouvé le bon ordre du code que je viens partager avec la communauté :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub convert_codebarre2()
Dim iRst As DAO.Recordset
Dim iDb As DAO.Database
Dim RefA As String
Dim RefB As String
 
Set iDb = CurrentDb
'Set iRst = iDb.OpenRecordset("Tbl_Immo", dbOpenTable)
Set iRst = iDb.OpenRecordset("Tbl_Immo", dbOpenDynaset) ' nouveau
 
While Not iRst.EOF
    With iRst ' nouveau
        iRst.Edit
        RefA = iRst.Fields("Codbarreimmo").Value
        If Len(RefA) = 25 And Left(RefA, 5) = "10029" Then
            RefB = Mid(RefA, 8, 3) & Mid(RefA, 11, 3) & "26" & Mid(RefA, 14, 8)
            iRst.Fields("Codbarreimmo").Value = RefB  ' nouveau
            iRst.Update
        Else  
            RefB = RefA
        End If
    End With
    iRst.MoveNext
Wend
 
iRst.Close
iDb.Close
Set iRst = Nothing
Set iDb = Nothing
MsgBox ("Terminé !!"), vbInformation
 
End Sub

Une fois de plus merci et merci encore pour toutes vos contributions.

Sur ce, le problème est