Sujet Précédent Sujet Suivant

[VB6 -> VBA]Macro pour enregistrer fichier sous

poybi64 Messages postés 11 Date d'inscription lundi 5 septembre 2011 Statut Membre Dernière intervention 11 février 2015 - 22 janv. 2013 à 17:29
poybi64 Messages postés 11 Date d'inscription lundi 5 septembre 2011 Statut Membre Dernière intervention 11 février 2015 - 23 janv. 2013 à 12:24
Bonjour,

Après avoir passé quelques heures à m'arracher les cheveux, je fais appel à votre aide.
Je dois modifier une macro existante car elle ne correspond plus à mes besoins :

Elle permet d'ouvrir une fenêtre est de scanner un code barre de 10 caractères de façon à créer un fichier.sds qui porte le nom du code barre.


De plus, lorsqu'on ouvre le fichier.sds , un champs est informé du même numéro :


Mon problème est que aujourd'hui le nombre de digit dans mon code barre est variable et est supérieur à 10 donc la macro ne fonctionne plus.

J'ai réussi à modifier la macro pour que ça fonctionne avec 17 digits mais ce n'est pas variable... Si mon code barre a moins de digits, ça bug!

Pour infor : la macro fait appel a un fichier.sds template (SNP_template.sds) dans lequel est complété le champs Barcode avec 17 digits.

Voici la macro :

Option Compare Database

Public Function CreateTemplate()
Dim nfic1 As Variant
Dim nfic2 As Variant
Dim strChar As Byte
Dim nbToRead As Long
Dim nbRead As Long
Dim sDir As String
Const sSubDir As String = "fichiersSDS"
Dim strPlateName As String
Dim i As Byte
Dim dlgBox As MSComDlg.CommonDialog

If Environ("UserName") = "sspouy" Then
sDir = "C:\Applied Biosystems\Template"
sfichier = "SNP_template.sds"
i = 50
Else
Set dlgBox = New MSComDlg.CommonDialog
With dlgBox
.DialogTitle = "Please Select a sds file"
.Filter = "SDS File (*.sds)|*.sds"
.InitDir = sDir
.CancelError = False
.ShowOpen
sDir = Replace(.FileName, .FileTitle, vbNullString)
sfichier = .FileTitle
If sfichier = vbNullString Then Exit Function
End With
i = 47
End If

Do While True
strPlateName = InputBox("Veuillez saisir ou scanner le nom de la plaque à créer. " & _
"Cette plaque sera copiée dans " & sDir & sSubDir & ".", "Copie du Template", "")
If strPlateName = "" Then Exit Do
nfic1 = 1
nfic2 = 2
Close nfic1
Close nfic2
If Not Dir(sDir & sSubDir & "" & strPlateName & ".sds", vbNormal) = "" Then
If MsgBox("Le fichier destination existe déjà. Voulez-vous l'écraser ?", vbQuestion + vbYesNo + vbDefaultButton2) = vbNo Then Exit Do
End If
If Dir(sDir & sSubDir, vbDirectory) = "" Then MkDir (sDir & sSubDir)
Open sDir & sfichier For Binary As nfic1
Open sDir & sSubDir & "" & strPlateName & ".sds" For Binary As nfic2
nbToRead = LOF(1)
nbRead = 1
Do While nbRead < nbToRead + 1
Get nfic1, nbRead, strChar
If nbRead >= 30 And nbRead <= i Then
If nbRead = 30 Then
strChar = Asc(Mid(strPlateName, 1, 1))
ElseIf nbRead = 31 Then
strChar = Asc(Mid(strPlateName, 2, 1))
ElseIf nbRead = 32 Then
strChar = Asc(Mid(strPlateName, 3, 1))
ElseIf nbRead = 33 Then
strChar = Asc(Mid(strPlateName, 4, 1))
ElseIf nbRead = 34 Then
strChar = Asc(Mid(strPlateName, 5, 1))
ElseIf nbRead = 35 Then
strChar = Asc(Mid(strPlateName, 6, 1))
ElseIf nbRead = 36 Then
strChar = Asc(Mid(strPlateName, 7, 1))
ElseIf nbRead = 37 Then
strChar = Asc(Mid(strPlateName, 8, 1))
ElseIf nbRead = 38 Then
strChar = Asc(Mid(strPlateName, 9, 1))
ElseIf nbRead = 39 Then
strChar = Asc(Mid(strPlateName, 10, 1))
ElseIf nbRead = 40 Then
strChar = Asc(Mid(strPlateName, 11, 1))
ElseIf nbRead = 41 Then
strChar = Asc(Mid(strPlateName, 12, 1))
ElseIf nbRead = 42 Then
strChar = Asc(Mid(strPlateName, 13, 1))
ElseIf nbRead = 43 Then
strChar = Asc(Mid(strPlateName, 14, 1))
ElseIf nbRead = 44 Then
strChar = Asc(Mid(strPlateName, 15, 1))
ElseIf nbRead = 45 Then
strChar = Asc(Mid(strPlateName, 16, 1))
ElseIf nbRead = 46 Then
strChar = Asc(Mid(strPlateName, 17, 1))
End If
End If
Put nfic2, nbRead, strChar
nbRead = nbRead + 1
Loop
Close nfic1
Close nfic2
Loop
End Function

J'aimerai donc que vous m'aidiez modifier la macro pour :
si digit1 présent alors tu copies et tu passes au 2
si digit2 présent tu copies et tu passes au 3
si digit3 absent alors tu t'arrêtes...
Un truc comme àça mais en code VBA :o)

Merci d'avance pour votre aide.
Sabine

2 réponses

Réponse 1 / 2
cs_Jack Messages postés 14006 Date d'inscription samedi 29 décembre 2001 Statut Modérateur Dernière intervention 28 août 2015 79
23 janv. 2013 à 10:29
Salut

Ton code, présenté comme ça, ne donne pas envoie de s'y intéresser.
On demande à tou(te)s d'utiliser la coloration syntaxique (3ème icone à droite) pour le rendre presque identique à la présentation réelle.

-1- numéro des fichiers ouverts
Tu prends le soin d'utiliser des variables, nfic1 et nfic2, pour ouvrir tes fichiers.
Plus loin, au lieu d'utiliser ces variables, tu colles un 1 : pas logique : --> LOF(nfic1)
De plus, pour être parfait, n'impose pas ces numéros; laisse VB les incrémenter : 
    nfic1 = FreeFile
    Open ...
    nfic2 = FreeFile
    Open ...
-2- Pense à préciser/protéger tes accès aux fichiers :
Si tu ne dois que lire, ajoute "Access Read" dans la ligne du Open, par sécurité.
-3- Avalanche de If
Si le byte lu est entre 30 et 47 (i), alors tu viens lire un byte dans le nom du fichier. Pourquoi pas.
Il y a là un moyen calculable de faire plus simple pour remplacer cet arbre de noël : 
strChar = Asc(Mid$(strPlateName, nbRead - 29, 1))

Quant à ta question, il va falloir expliquer ce que tu appelles un "digit présent"

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on le partage (Socrate)
0
Réponse 2 / 2
poybi64 Messages postés 11 Date d'inscription lundi 5 septembre 2011 Statut Membre Dernière intervention 11 février 2015
23 janv. 2013 à 12:24
Bonjour,

Je m'excuse mais je ne suis absolument pas une experte en VB.
Je n'ai pas écrit ce code. J'ai juste essayé de le modifier avec ce que j'arrivais à comprendre...
Résultat, un joli arbre de noël comme tu dis.

Merci pour ta réponse mais je n'ai pas compris... Je ne sais même pas ce que c'est qu'un Byte...

Voici le code avec la coloration syntaxique comme demandé. 
Option Compare Database

Public Function CreateTemplate()
Dim nfic1 As Variant
Dim nfic2 As Variant
Dim strChar As Byte
Dim nbToRead As Long
Dim nbRead As Long
Dim sDir As String
Const sSubDir As String = "fichiersSDS"
Dim strPlateName As String
Dim i As Byte
Dim dlgBox As MSComDlg.CommonDialog

    If Environ("UserName") = "sspouy" Then
        sDir = "C:\Applied Biosystems\Template"
        sfichier = "SNP_template.sds"
        i = 50
    Else
        Set dlgBox = New MSComDlg.CommonDialog
        With dlgBox
            .DialogTitle = "Please Select a sds file"
            .Filter = "SDS File (*.sds)|*.sds"
            .InitDir = sDir
            .CancelError = False
            .ShowOpen
            sDir = Replace(.FileName, .FileTitle, vbNullString)
            sfichier = .FileTitle
            If sfichier = vbNullString Then Exit Function
        End With
        i = 47
    End If
       
    Do While True
        strPlateName = InputBox("Veuillez saisir ou scanner le nom de la plaque à créer. " & _
                                "Cette plaque sera copiée dans " & sDir & sSubDir & ".", "Copie du Template", "")
        If strPlateName = "" Then Exit Do
        nfic1 = 1
        nfic2 = 2
        Close nfic1
        Close nfic2
        If Not Dir(sDir & sSubDir & "" & strPlateName & ".sds", vbNormal) = "" Then
            If MsgBox("Le fichier destination existe déjà. Voulez-vous l'écraser ?", vbQuestion + vbYesNo + vbDefaultButton2) = vbNo Then Exit Do
        End If
        If Dir(sDir & sSubDir, vbDirectory) = "" Then MkDir (sDir & sSubDir)
        
        Open sDir & sfichier For Binary As nfic1
        Open sDir & sSubDir & "" & strPlateName & ".sds" For Binary As nfic2
        nbToRead = LOF(1)
        nbRead = 1
        Do While nbRead < nbToRead + 1
            Get nfic1, nbRead, strChar
            If nbRead >= 30 And nbRead <= i Then
                If nbRead = 30 Then
                    strChar = Asc(Mid(strPlateName, 1, 1))
                ElseIf nbRead = 31 Then
                    strChar = Asc(Mid(strPlateName, 2, 1))
                ElseIf nbRead = 32 Then
                    strChar = Asc(Mid(strPlateName, 3, 1))
                ElseIf nbRead = 33 Then
                    strChar = Asc(Mid(strPlateName, 4, 1))
                ElseIf nbRead = 34 Then
                    strChar = Asc(Mid(strPlateName, 5, 1))
                ElseIf nbRead = 35 Then
                    strChar = Asc(Mid(strPlateName, 6, 1))
                ElseIf nbRead = 36 Then
                    strChar = Asc(Mid(strPlateName, 7, 1))
                ElseIf nbRead = 37 Then
                    strChar = Asc(Mid(strPlateName, 8, 1))
                ElseIf nbRead = 38 Then
                    strChar = Asc(Mid(strPlateName, 9, 1))
                ElseIf nbRead = 39 Then
                    strChar = Asc(Mid(strPlateName, 10, 1))
                ElseIf nbRead = 40 Then
                    strChar = Asc(Mid(strPlateName, 11, 1))
                ElseIf nbRead = 41 Then
                    strChar = Asc(Mid(strPlateName, 12, 1))
                    ElseIf nbRead = 42 Then
                    strChar = Asc(Mid(strPlateName, 13, 1))
                    ElseIf nbRead = 43 Then
                    strChar = Asc(Mid(strPlateName, 14, 1))
                    ElseIf nbRead = 44 Then
                    strChar = Asc(Mid(strPlateName, 15, 1))
                    ElseIf nbRead = 45 Then
                    strChar = Asc(Mid(strPlateName, 16, 1))
                    ElseIf nbRead = 46 Then
                    strChar = Asc(Mid(strPlateName, 17, 1))
                    
                   
             End If
            End If
            Put nfic2, nbRead, strChar
            nbRead = nbRead + 1
        Loop
        Close nfic1
        Close nfic2
    Loop
End Function


Pour finir, dans mon language approximatif en VB, j'appelle "Digit présent" un caractère.
Exemple : A_123456_AB contient 11 digits avec digit1=A, digit2=_, digit3=1, ....

Merci.
Sabine
0

Discussions similaires

Comment fonctionne la fonction FormulaR1C1
cs_razmokets -
wape -

2 réponses
fonction modulo en VBA
krisprolss -
Benouille -

2 réponses
access vba recherche de donnee ds une table
yafisab -
yafisab -

2 réponses
Ouvrir un classeur Excel par macro sans l'afficher
maxxyme -
rvblog -

12 réponses
Dernière cellule non vide d'une colonne
cs_falafala -
Luigi13013 -

5 réponses
Rejoignez-nous