VBA vérifier des noms
s
souri84Membre impliqué
- Messages
- 1'042
- Excel
- 2003 FR / 2007 UK
- Inscrit
- 7.05.2007
- Emploi
- Consultant en finance
Bonjour à tous,
J'ai encore un souci en VBA, toujours pour vérifier que les noms des fichiers sont bien normalisés...
voici ma macro:
Sub test2()
'********************************************************
'déclaration des variables
Dim confirmations1 As Range
Dim Confirmations As String
Dim Mylen
Dim SICO
Dim RefBO
Dim DateRefBO
'selection de la lettre réseau
Sheets("paramétrages").Select
Range("B4").Select
'si la cellule active = "", erreur
If ActiveCell = "Lettre réseau" Then
MsgBox ("entrez votre lettre réseau...")
arret = True
Else
Sheets("paramétrages").Select
Range("B4").Select
'********************************************************
'repertoire = la valeur en C13 de la page paramtrages
repertoire = [C2]
'utilisation de l'outil filsearch d'Excel
With Application.FileSearch
'répertoire des conf
.LookIn = repertoire
'nom et type de fichier
.Filename = "*.pdf"
'executer la macro
.Execute
'les mettre les uns en dessous des autres
Sheets("fichiers trouvés").Select
For i = 1 To .FoundFiles.Count
Cells(i + 5, 1) = .FoundFiles(i)
Next
'********************************************************
'convertir les données
'oter l'adresse réseau
Range("A6").Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.TextToColumns Destination:=Range("A6"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="\", FieldInfo:=Array(Array(1, 9), Array(2, 9), Array(3, 9), Array(4, 9), Array(5, _
9), Array(6, 1)), TrailingMinusNumbers:=True
'oter le .pdf
Range("A6").Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.TextToColumns Destination:=Range("A6"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=".", FieldInfo:=Array(Array(1, 1), Array(2, 9)), TrailingMinusNumbers:=True
Range("A6").Select
'clear B:B
Range("B:B").Clear
'***********************************************************
'Vérifier les noms de fichiers
'Confirmations =
Mylen = Len(CStr(SICO)) = 10
Mylen = Len(CStr(RefBO)) = 12
Mylen = Len(CStr(DateRefBO)) = 6
Confirmations = DateRefBO & "_" & SICO & "_" & RefBO
Range("A6").Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
For Each confirmations1 In Selection
If Len(confirmations1) = Len(Confirmations) Then
Else
ActiveCell.Copy
ActiveCell.Offset(0, 1).PasteSpecial (xlPasteValues)
End If
Next confirmations1
End With
End If
End Sub
Comme vous l'aurez compris, j'ai un souci dans la partie:
'***********************************************************
'Vérifier les noms de fichiers
'Confirmations =
Mylen = Len(CStr(SICO)) = 10
Mylen = Len(CStr(RefBO)) = 12
Mylen = Len(CStr(DateRefBO)) = 6
Confirmations = DateRefBO & "_" & SICO & "_" & RefBO
Range("A6").Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
For Each confirmations1 In Selection
If Len(confirmations1) = Len(Confirmations) Then
Else
ActiveCell.Copy
ActiveCell.Offset(0, 1).PasteSpecial (xlPasteValues)
End If
Next confirmations1
End With
End If
End Sub
Je souhaiterais vérifier que chaque noms dans la selection fait bien 30 caractères et qu'elle soit bien du type YYMMDD_10chiffres_ 3 lettres + 9 chiffres
Merci à celui qui m'aidra,
s
souri84Membre impliqué
- Messages
- 1'042
- Excel
- 2003 FR / 2007 UK
- Inscrit
- 7.05.2007
- Emploi
- Consultant en finance
c bon, j'ai trouvé... ça fait quelques jours que je suis dessus et il a fallu que je poste pour que je trouve... j'ai un peu simplifié...:
Sub test1()
'********************************************************
'déclaration des variables
Dim confirmations1 As Range
Dim Confirmations As String * 30
Dim Mylen, Mystring
'selection de la lettre réseau
Sheets("paramétrages").Select
Range("B4").Select
'si la cellule active = "", erreur
If ActiveCell = "Lettre réseau" Then
MsgBox ("entrez votre lettre réseau...")
arret = True
Else
Sheets("paramétrages").Select
Range("B4").Select
'********************************************************
'repertoire = la valeur en C13 de la page paramtrages
repertoire = [C2]
'utilisation de l'outil filsearch d'Excel
With Application.FileSearch
'répertoire des conf
.LookIn = repertoire
'nom et type de fichier
.Filename = "*.pdf"
'executer la macro
.Execute
'les mettre les uns en dessous des autres
Sheets("fichiers trouvés").Select
For i = 1 To .FoundFiles.Count
Cells(i + 5, 1) = .FoundFiles(i)
Next
'********************************************************
'convertir les données
'oter l'adresse réseau
Range("A6").Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.TextToColumns Destination:=Range("A6"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="\", FieldInfo:=Array(Array(1, 9), Array(2, 9), Array(3, 9), Array(4, 9), Array(5, _
9), Array(6, 1)), TrailingMinusNumbers:=True
'oter le .pdf
Range("A6").Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.TextToColumns Destination:=Range("A6"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=".", FieldInfo:=Array(Array(1, 1), Array(2, 9)), TrailingMinusNumbers:=True
Range("A6").Select
'clear B:B
Range("B:B").Clear
'**********************************************************************************
'vérifier les noms
' def RefBo
Mylen = Len(Confirmations)
'si confirmation ne correspond pas à ça alors FAUX
Range("A6").Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
For Each confirmations1 In Selection
If Len(confirmations1) <> 30 Then
ActiveCell.Copy
ActiveCell.Offset(0, 1).Activate
ActiveCell.Offset.PasteSpecial (xlPasteAll)
ActiveCell.Offset(1, -1).Activate
Else
ActiveCell.Offset(1, 0).Activate
End If
Next confirmations1
End With
End If
End Sub