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 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89
|
Private Sub import_Click()
Dim NoCarTAB As Long 'caractère de tabulation, donc de changement de champ
Dim NoCarENT As Long 'caractère d'entrée, donc de changement de ligne
Dim NoCarPrec As Long 'caractère précédent
Dim TabChamp(7) As Variant 'Table regroupant mes 7 champs
Dim NoCar As Long 'longeur de la chaine à importer dans un champ
Dim NumChamp As Long 'numéro de champ
Dim NoNolonne As Long 'numéro de colonne
Set TabChamp(1) = Me.Code
Set TabChamp(2) = Me.Désignation
Set TabChamp(3) = Me.Limitation_configurable
Set TabChamp(4) = Me.ATO
Set TabChamp(5) = Me.ATF
Set TabChamp(6) = Me.FIL
Set TabChamp(7) = Me.FV
ChaineRecherche = ClipBoard_GetData() 'correspond à la zone copiée
NoCarPrec = 1 '
NumChamp = 1 ' initialisation des variables
NoColonne = 1 '
Do While (NoCarPrec <= Len(ChaineRecherche))
NoCarTAB = InStr(NoCarPrec, ChaineRecherche, Chr(9))
NoCarENT = InStr(NoCarPrec, ChaineRecherche, Chr(13))
If (NoCarTAB < NoCarENT And Not NoCarTAB = 0 And Not NoCarTAB = NoCarPrec And Not NoCarENT = NoCarPrec) Or NoCarENT = 0 Then
NoCar = NoCarTAB - NoCarPrec
TabChamp(NumChamp).Value = Mid(ChaineRecherche, NoCarPrec, NoCar)
NoCarPrec = NoCarTAB + 1
NumChamp = NumChamp + 1
NoColonne = NoColonne + 1
End If
If NoCarENT > 0 And NoCarENT < NoCarTAB Then
NoCar = NoCarENT - NoCarPrec
TabChamp(NumChamp).Value = Mid(ChaineRecherche, NoCarPrec, NoCar)
DoCmd.GoToRecord , Table_Configurables_sous_formulaire, acNewRec
NoCarPrec = NoCarENT + 2
NumChamp = 1
NoColonne = 1
End If
If NoCarTAB = 0 Then
NoCar = Len(ChaineRecherche) - NoCarPrec - 1
TabChamp(NumChamp).Value = Mid(ChaineRecherche, NoCarPrec, NoCar)
NoCarPrec = Len(ChaineRecherche) + 1
End If
If NoCarTAB = NoCarPrec Then
TabChamp(NumChamp).Value = Null
NoCarPrec = NoCarTAB + 1
NumChamp = NumChamp + 1
NoColonne = NoColonne + 1
End If
If NoCarENT = NoCarPrec Then
TabChamp(NumChamp).Value = Null
DoCmd.GoToRecord , Table_Configurables_sous_formulaire, acNewRec
NoCarPrec = NoCarENT + 2
NumChamp = 1
NoColonne = 1
End If
If NoColonne > 7 Then
MsgBox (" Vous avez selectionné une zone de copie de taille trop importante")
Me.Undo
End If
Loop
End Sub |
Partager