Macro de verification données images

roidurif · 22 Janvier 2009

Bonjour,

j'aimerais rajouter une macro pour retranscrire cela et qui vérifie :

- La colonne Photo (BD) doit etre renseigné :
d'un préfixe "le numéro de contrat cellule A"_ "nom de l'image" extension ".jpg ou .gif "
ex : 1233_photo_stylo.jpg
les espaces blancs sont interdit
=> si format different par exemple :
"photo_stylo.jpg" (ne contient pas le numéro client de la colonne A) ou
"1233 photo stylo " (ne contient pas d'extention .jpg ou .gif) ou
"1233 photo stylo.gif " (ne contient pas d' underscore (_) au lieu des espace ( )ou

Alors inscrire "Numéro célulle" dans l' onglet feuil2 (Nom Image incohérent)

merci d avance

Cdt

PMO2 · 23 Janvier 2009

Re : Macro de verification données images

Bonjour,

Une piste avec le code suivant à copier dans un module standard

Code:

'### Nom des feuilles à adapter ###
Const SOURCE As String = "Feuil1"
Const DEST As String = "Feuil2"
'##################################
Sub CleanImages()
Dim var
Dim R As Range
Dim S As Worksheet
Dim i&
Dim cpt&
Dim A$
Dim bool As Boolean
Dim T()
Set S = ActiveWorkbook.Sheets(SOURCE)
Set R = S.Range(S.Cells(1, 1), S.Cells(S.[bd65536].End(xlUp).Row, 56))
var = R
For i& = 2 To UBound(var, 1)
  bool = False
  A$ = var(i&, 56) 'commodité d'écriture
    If A$ <> "" Then
    If LCase(Right(A$, 4)) <> ".jpg" And _
       LCase(Right(A$, 4)) <> ".gif" Then bool = True
    If Left(A$, Len(Trim(var(i&, 1)))) <> Trim(var(i&, 1)) Then bool = True
    If InStr(1, A$, Chr(160)) Then bool = True
    If InStr(1, A$, Space(1)) Then bool = True
    If InStr(1, A$, "_") = 0 Then bool = True
    If bool Then
      cpt& = cpt& + 1
      ReDim Preserve T(1 To 1, 1 To cpt&)
      T(1, cpt&) = "$BD$" & i&
    End If
  End If
Next i&
Set S = ActiveWorkbook.Sheets(DEST)
S.Range("b16:iv16").ClearContents
Set R = S.Range(S.Cells(16, 2), S.Cells(16, UBound(T, 2) + 1))
R = T
End Sub

Cordialement.

PMO
Patrick Morange

roidurif · 23 Janvier 2009

Re : Macro de verification données images

Bonsoir PMO,

vous êtes un chef, ca marche nickel sauf j ai toujours $BD12$ qui s affiche comme une donnée format image incorrect, alors que le nom d image que j ai saisie est la bonne forme.

Je vous joins ce ke j ai fait

Merci bcp de votre aide

PMO2 · 24 Janvier 2009

Re : Macro de verification données images

Bonjour,

j ai toujours $BD$12 qui s affiche comme une donnée format image incorrect

Le 1233 de "1233_photo_stylo.jpg" ne correspond pas à 1254 (valeur en A12)

Dans le même esprit, je vois que la cellule A18 n'est pas renseignée et qu'on ne signale pas l'invalidité de la cellule BD18 ("1233_photo_stylo.jpg").
Il faut ajouter une ligne au code (celle qui comporte 'ajout 24/01/09).
Veuillez trouver ci-dessous le code modifié.

Code:

Sub CleanImages()
Dim var
Dim R As Range
Dim S As Worksheet
Dim i&
Dim cpt&
Dim A$
Dim bool As Boolean
Dim T()
Set S = ActiveWorkbook.Sheets("Feuil1")
Set R = S.Range(S.Cells(1, 1), S.Cells(S.[bd65536].End(xlUp).Row, 56))
var = R
For i& = 2 To UBound(var, 1)
  bool = False
  A$ = var(i&, 56) 'commodité d'écriture
    If A$ <> "" Then
    If LCase(Right(A$, 4)) <> ".jpg" And _
       LCase(Right(A$, 4)) <> ".gif" Then bool = True
    If Left(A$, Len(Trim(var(i&, 1)))) <> Trim(var(i&, 1)) Then bool = True
    If var(i&, 1) = "" Then bool = True   'ajout 24/01/09
    If InStr(1, A$, Chr(160)) Then bool = True
    If InStr(1, A$, Space(1)) Then bool = True
    If InStr(1, A$, "_") = 0 Then bool = True
    If bool Then
      cpt& = cpt& + 1
      ReDim Preserve T(1 To 1, 1 To cpt&)
      T(1, cpt&) = "$BD$" & i&
    End If
  End If
Next i&
Set S = ActiveWorkbook.Sheets("Feuil2")
S.Range("b16:iv16").ClearContents
Set R = S.Range(S.Cells(16, 2), S.Cells(16, UBound(T, 2) + 1))
R = T
End Sub

Cordialement.

PMO
Patrick Morange

roidurif · 25 Janvier 2009

Re : Macro de verification données images

Merci Patrick, vous un chef

Dites moi dans mon fichier, j'avais intégrer une macro"Ctrlprix" qui contrôle le format des Prix qui disait :

- La colonne Prix (AH) doit accepter ce format par exemple :
0.00 (Deux chiffres apres le point) ou
0.0 (Un chiffre après le point pour les arrondis)

=> si format different par exemple :
0,000 ou 0.000 (contient virgule ou plus de 2 decimale) ou
0,00€ (contient lettres Euro ou Eur ou ....)

alors inscrire "Numéro célulle" dans l' onglet feuil2 (Prix incohérent)

La macro ci-dessous marche uniquement lorsque le séparateur est une virgule (,) et non pas un point (.) comme souhaité :

J'aimerais bien que vous jetiez un œil SVP, si ça vous derrange pas

Merci

Code:
Sub CtrlPrix()
Dim Prix As Range
Sheets("Feuil2").Range("B14:IV14").Clear
With Sheets("Feuil1")
For Each Prix In .Range("AH2", .[AH65536].End(xlUp)).SpecialCells(xlCellTypeConstants)
If Prix.NumberFormat <> "0.0" And Prix.NumberFormat <> "0.00" _
And Not Prix.Value Like "#,##" And Not Prix.Value Like "#,#" _
And Not Prix.Value Like "##,##" And Not Prix.Value Like "##,#" _
Or TypeName(Prix.Value) = "String" Or Not Prix.Text Like "*#" Then _
Sheets("Feuil2").Range("IV14").End(xlToLeft).Offset(0, 1).Value = Prix.Address
Next
End With
End Sub

PMO2 · 25 Janvier 2009

Re : Macro de verification données images

Bonjour,

Voici votre code modifié. Remplacez l'ancienne Sub CtrlPrix par le code ci-dessous.

Code:

Sub CtrlPrix_pmo()
Dim C As Range
Dim DecSep$
DecSep$ = Application.International(xlDecimalSeparator)
Sheets("Feuil2").Range("B14:IV14").Clear
With Sheets("Feuil1")
  For Each C In .Range("AH2", .[AH65536].End(xlUp)).SpecialCells(xlCellTypeConstants)
    If DecSep$ = "." Then
      C.Replace ",", DecSep$
    ElseIf DecSep$ = "," Then
      C.Replace ".", DecSep$
    End If
    C.NumberFormat = "0.00"
    If IsNumeric(C) Then
      C = C.Value
    Else
      Sheets("Feuil2").Range("IV14").End(xlToLeft).Offset(0, 1).Value = C.Address
    End If
  Next C
End With
Call CleanImages
End Sub

Plutôt que de signaler systématiquement toutes les erreurs, je fait d'abord un cleaning (qui change les valeurs récupérables en AH)
puis j'écris les erreurs en ligne 14 de la Feuil2.

Cordialement.

PMO
Patrick Morange

roidurif · 25 Janvier 2009

Re : Macro de verification données images

Merci patrick,

Merci de ton aide, par contre la condition 2 chiffres maximum après le point a disparu (Le format 0.000 ou 0,000 est interdit)

Il reconnait pas les erreurs 0.000

ex : AH19 de la feuil1

Merci

roidurif · 26 Janvier 2009

Re : Macro de verification données images

Bonjour,

J'ai un message d erreur lorsque cette macro s exécute, uniquement lorsque tout les champs de la colonne (BD) et la colonne (A) sont correctement bien renseigné :

Merci

Sub CleanImages()
Dim var
Dim R As Range
Dim S As Worksheet
Dim i&
Dim cpt&
Dim A$
Dim bool As Boolean
Dim T()
Set S = ActiveWorkbook.Sheets("Feuil1")
Set R = S.Range(S.Cells(1, 1), S.Cells(S.[bd65536].End(xlUp).Row, 56))
var = R
For i& = 2 To UBound(var, 1)
bool = False
A$ = var(i&, 56) 'commodité d'écriture
If A$ <> "" Then
If LCase(Right(A$, 4)) <> ".jpg" And _
LCase(Right(A$, 4)) <> ".gif" Then bool = True
If Left(A$, Len(Trim(var(i&, 1)))) <> Trim(var(i&, 1)) Then bool = True
If InStr(1, A$, Chr(160)) Then bool = True
If InStr(1, A$, Space(1)) Then bool = True
If InStr(1, A$, "_") = 0 Then bool = True
If bool Then
cpt& = cpt& + 1
ReDim Preserve T(1 To 1, 1 To cpt&)
T(1, cpt&) = "$BD$" & i&
End If
End If
Next i&
Set S = ActiveWorkbook.Sheets("Feuil2")
S.Range("b16:iv16").ClearContents
Set R = S.Range(S.Cells(16, 2), S.Cells(16, UBound(T, 2) + 1))
R = T
End Sub

PMO2 · 26 Janvier 2009

Re : Macro de verification données images

Bonjour,

C'est un bug de logique. J'avais oublié le cas où il n'y a aucune erreur à signaler.
Voici le code corrigé

Code:

Sub CleanImages()
Dim var
Dim R As Range
Dim S As Worksheet
Dim i&
Dim cpt&
Dim A$
Dim bool As Boolean
Dim T()
Set S = ActiveWorkbook.Sheets("Feuil1")
Set R = S.Range(S.Cells(1, 1), S.Cells(S.[bd65536].End(xlUp).Row, 56))
var = R
For i& = 2 To UBound(var, 1)
  bool = False
  A$ = var(i&, 56) 'commodité d'écriture
    If A$ <> "" Then
    If LCase(Right(A$, 4)) <> ".jpg" And _
       LCase(Right(A$, 4)) <> ".gif" Then bool = True
    If Left(A$, Len(Trim(var(i&, 1)))) <> Trim(var(i&, 1)) Then bool = True
    If var(i&, 1) = "" Then bool = True
    If InStr(1, A$, Chr(160)) Then bool = True
    If InStr(1, A$, Space(1)) Then bool = True
    If InStr(1, A$, "_") = 0 Then bool = True
    If bool Then
      cpt& = cpt& + 1
      ReDim Preserve T(1 To 1, 1 To cpt&)
      T(1, cpt&) = "$BD$" & i&
    End If
  End If
Next i&
Set S = ActiveWorkbook.Sheets("Feuil2")
S.Range("b16:iv16").ClearContents
[COLOR="Blue"]If cpt& > 0 Then    '///ajout pmo 26/01/09[/COLOR]
  Set R = S.Range(S.Cells(16, 2), S.Cells(16, UBound(T, 2) + 1))
  R = T
[COLOR="blue"]End If      '///ajout pmo 26/01/09[/COLOR]
End Sub

Cordialement.

PMO
Patrick Morange

roidurif · 26 Janvier 2009

Re : Macro de verification données images

Merci PMO,

Merci de ton aide, je c pas si tu pu voir 2 post dessus, pour le format des prix la condition 2 chiffres maximum après le point a disparu (Le format 0.000 ou 0,000 est interdit)

Il reconnait pas les erreurs 0.000

ex : AH19 de la feuil1

Merci

PMO2 · 26 Janvier 2009

Re : Macro de verification données images

Bonsoir,

J'ai beau télécharger les différents fichiers zippés de ce fil, je ne vois pas de format 0.000 dans AH19 de la feuil1.
Pouvez vous mettre le classeur concerné en pièce jointe.

Cordialement.

PMO
Patrick Morange

roidurif · 26 Janvier 2009

Re : Macro de verification données images

Bonsoir,

Comme demander, voici le fichier

Vous verrez en AH19 = 9.835 c est arrondi à 9.84

De plus, je viens de m apercevoir, dans la colonne prix quand j'ai fai un copier coller de prix d'un autre fichier, La macro "CtrlPrix" detecte le format incorrect pour des prix correct 0.00

J'ai mis le fichier en exemple ci joint

Merci bcp de votre aide

PMO2 · 27 Janvier 2009

Re : Macro de verification données images

Bonjour,

En ce qui concerne la Sub CtrlPrix, j'ai modifié le code pour que les prix avec plus de 2 décimales soient détectés

Code:

Sub CtrlPrix()
Dim C As Range
Dim DecSep$
Dim x#
DecSep$ = Application.International(xlDecimalSeparator)
Sheets(CONTROLE).Range("B14:IV14").Clear
With Sheets(DATA)
  For Each C In .Range("AH2", .[AH65536].End(xlUp)).SpecialCells(xlCellTypeConstants)
    If DecSep$ = "." Then
      C.Replace ",", DecSep$
    ElseIf DecSep$ = "," Then
      C.Replace ".", DecSep$
    End If
    C.NumberFormat = "0.00"
    If IsNumeric(C) Then
      C = C.Value
        '--- Détection des nombres avec plus de 2 décimales ---
      x# = C
      If CDbl(CLng(x# * 100) / 100) <> x# Then
        C.NumberFormat = "General"
        Sheets(CONTROLE).Range("IV14").End(xlToLeft).Offset(0, 1).Value = C.Address(REF_ABS, REF_ABS)
      End If
        '------------------------------------------------------
    Else
      Sheets(CONTROLE).Range("IV14").End(xlToLeft).Offset(0, 1).Value = C.Address(REF_ABS, REF_ABS)
    End If
  Next C
End With
Call CleanImages
End Sub

D'autre part et pour des raisons de commodité, j'ai ajouté 3 constantes tout en haut du code

Code:

'### Constantes à adapter ###
Const DATA As String = "Feuil1"     'Feuille des données
Const CONTROLE As String = "Feuil2" 'Feuille des contrôles
Const REF_ABS  As Boolean = False   'Références absolues des adresses
'############################

Il faudra que vous adaptiez les 2 premières par les noms des feuilles concernées.
La constante REF_ABS qui est soit True ou False détermine l'affichage des adresses
soit sous la forme $BD$10 ou sous la forme BD10 que je trouve plus facile à lire pour l'utilisateur.

Cordialement.

PMO
Patrick Morange

roidurif · 27 Janvier 2009

Re : Macro de verification données images

Merci Patick

Je viens de faire un copier / coller de prix dans la colonne prix d'un autre fichier, La macro "CtrlPrix" detecte le format incorrect pour des prix correct en 0.00

Je comprend pas, je vous remerci enormement, J'ai mis le fichier en exemple ci joint

Cordialement Merci d avance

PMO2 · 27 Janvier 2009

Re : Macro de verification données images

Bonjour,

Je n'ai pas ce problème sur ma machine.
J'ai fait tourner la macro "CtrlPrix" et je n'obtiens aucune des anomalies que vous décrivez ???

J'ai encore modifié le code pour l'améliorer mais pas en ce qui concerne le problème signalé.

Cordialement.

PMO
Patrick Morange

Effectuez une recherche sur Excel Downloads...

Macro de verification données images

roidurif

XLDnaute Occasionnel

PMO2

XLDnaute Accro

roidurif

XLDnaute Occasionnel

Pièces jointes

PMO2

XLDnaute Accro

roidurif

XLDnaute Occasionnel

PMO2

XLDnaute Accro

roidurif

XLDnaute Occasionnel

roidurif

XLDnaute Occasionnel

PMO2

XLDnaute Accro

roidurif

XLDnaute Occasionnel

PMO2

XLDnaute Accro

roidurif

XLDnaute Occasionnel

PMO2

XLDnaute Accro

roidurif

XLDnaute Occasionnel

PMO2

XLDnaute Accro

Discussions similaires

Nous accordons de l'importance à votre vie privée