Macro de verification données images

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
R

roidurif

XLDnaute Occasionnel
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
 
Dernière édition:
Trier par date Trier par votes
Re : Macro de verification données images

Re-bonjour,

J'ai fait une copie d'ecran ci-joint;

Quand je fais un copier / coller de prix d'un fichier vers celui ci (Voir fichier hier à 12h14)
J'ai un petite triangle vert au coin gauche des celulle coller.

En passant la souris ou en cliquant dessus, il dit que le " Nombre stocké est sous forme de texte".

Du coup, la macro "Ctrlprix " identifie cela comme une erreure de saisie ou format.

Il faut convertir chaque celulle en nombre pour que ca marche.

Comment remedier à cela , pour améliorer la macro??

Merci d avance
 

Pièces jointes

  • Capturer.jpg
    Capturer.jpg
    35.6 KB · Affichages: 45
  • Capturer.jpg
    Capturer.jpg
    35.6 KB · Affichages: 42
  • Capturer.jpg
    Capturer.jpg
    35.6 KB · Affichages: 48
Vote positif 0 Vote négatif
Re : Macro de verification données images

Bonjour,

Essayez avec le code modifié suivant

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 = C.Value     '******28/01/09******
    C.NumberFormat = "0.00"
    If IsNumeric(C) Then
      C.HorizontalAlignment = xlRight '******28/01/09******
        '--- 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

Cordialement.

PMO
Patrick Morange
 
Vote positif 0 Vote négatif
Re : Macro de verification Séparateur (point) pour le prix

Bonjour,

D'apres le code, il dit que, si dans la colonne prix AH de l'onglet Feuil1, le séparteur prix est une virgule alors remplace le par le point (.), et si c'est un séparateur Point (.), alors c'est OK


Je ne comprens pas, lorsque la colonne (prix) AH est saisie avec un prix correct, 10.35 par exemple, en lancant la marco ci-dessous, il me le transforme en 10,35.

Alors que ca doit doit etre le contraire.

Merci de votre aide

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 = C.Value     '******28/01/09******
    C.NumberFormat = "0.00"
    If IsNumeric(C) Then
      C.HorizontalAlignment = xlRight '******28/01/09******
        '--- 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

Cordialement.
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Macro de verification données images

Bonjour,

Pour déterminer le symbole du séparateur décimal il y a 2 niveaux.

1) Au niveau du système
Si vous faites Démarrer/Panneau de configuration/Options régionales et linguistiques.
puis onglet Options régionales/Personnaliser...
puis Symbole système
vous verrez quel est le symbole du séparateur décimal utilisé par le système.

2) Au niveau d'Excel
Si vous faites menu Outils/Options... puis onglet International
vous verrez quel est le symbole du séparateur décimal utilisé par Excel.
Si la case Utiliser les séparateurs système, juste en dessous, est cochée alors la préséance va au système nonobstant le choix Excel.

Pour contourner cela mettez TOUT en tête du module contenant la sub CtrlPrix les instructions suivantes

Code: 
Private Declare Function GetLocaleInfo& Lib "kernel32" Alias "GetLocaleInfoA" _
  (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, _
   ByVal cchData As Long)
Private Declare Function GetSystemDefaultLCID& Lib "kernel32" ()

Changez l'ancienne sub CtrlPrix par le nouveau code suivant

Code: 
Sub CtrlPrix() 'Contrôle Format Prix
Dim R As Range
Dim C As Range
Dim DecSep$
Dim x#
Dim SystemSeparator$
Dim tampon$
Dim LenTampon&
With Application
  If Application.UseSystemSeparators Then
    tampon$ = Space(255)
    LenTampon& = GetLocaleInfo(GetSystemDefaultLCID, &HE, tampon$, 255)
    DecSep$ = Left$(tampon$, LenTampon& - 1)
  Else
    DecSep$ = Application.International(xlDecimalSeparator)
  End If
End With
Sheets(CONTROLE).Range("B14:IV14").Clear
With Sheets(DATA)
  Set R = .Range("AH2", .[AH65536].End(xlUp))
  For Each C In R
    If DecSep$ = "." Then
      C.Replace ",", DecSep$
    ElseIf DecSep$ = "," Then
      C.Replace ".", DecSep$
    End If
    C = C.Value     '******28/01/09******
    C.NumberFormat = "0.00"
    If IsNumeric(C) Then
      C.HorizontalAlignment = xlRight '******28/01/09******
        C = CDbl(C)
        '--- 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


Cordialement.

PMO
Patrick Morange
 
Vote positif 0 Vote négatif
Re : Macro de verification données images

Je te remercie de l'aide que tu peux m apporter

J'ai essayer sur vista, la macro tourne mais c'est toujours pareils les virgules restent comme séparateur de prix tant

et sur Excel 2000, J'ai utilisé ta methode de contournement CtrlPrix, j'ai un probleme d'execution, je pense que cela ai dû fait que cela n'existe pas : Erreur exection 438 sur la ligne

Code: 
If Application.UseSystemSeparators Then

Bref je ne comprends pas.

j'ai trouvé quelque que chose sur ce site sur site, mais sa m'aide pas

http://social.msdn.microsoft.com/forums/fr-FR/vbafr/thread/41114b53-8bac-4fdf-a96b-7beddc892549/


Je te remercie bcp de ton aide,

Code: 
Private Declare Function GetLocaleInfo& Lib "kernel32" Alias "GetLocaleInfoA" _
  (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, _
   ByVal cchData As Long)
Private Declare Function GetSystemDefaultLCID& Lib "kernel32" ()

Changez l'ancienne sub CtrlPrix par le nouveau code suivant

Code: 
Sub CtrlPrix() 'Contrôle Format Prix
Dim R As Range
Dim C As Range
Dim DecSep$
Dim x#
Dim SystemSeparator$
Dim tampon$
Dim LenTampon&
With Application
  If Application.UseSystemSeparators Then
    tampon$ = Space(255)
    LenTampon& = GetLocaleInfo(GetSystemDefaultLCID, &HE, tampon$, 255)
    DecSep$ = Left$(tampon$, LenTampon& - 1)
  Else
    DecSep$ = Application.International(xlDecimalSeparator)
  End If
End With
Sheets(CONTROLE).Range("B14:IV14").Clear
With Sheets(DATA)
  Set R = .Range("AH2", .[AH65536].End(xlUp))
  For Each C In R
    If DecSep$ = "." Then
      C.Replace ",", DecSep$
    ElseIf DecSep$ = "," Then
      C.Replace ".", DecSep$
    End If
    C = C.Value     '******28/01/09******
    C.NumberFormat = "0.00"
    If IsNumeric(C) Then
      C.HorizontalAlignment = xlRight '******28/01/09******
        C = CDbl(C)
        '--- 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


Cordialement.
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Macro de verification données images

Bonjour,

Je reviens vers vous, sur la macro "contrôle Format images", j'ai une erreure d'excution des que je renseigne plusieurs celulle (jusqu' à BD5156 par exemple, mais je c pas si ca viens du nombre de celulle)

Ligne erreur excution :

Code: 
Set R = S.Range(S.Cells(16, 2), S.Cells(16, UBound(T, 2) + 1))

ci-dessous la macro

Merci

Voici la macro ci dessous :
Code: 
Sub CleanImages() 'Contrôle Format Images
Dim var
Dim R As Range
Dim S As Worksheet
Dim i&
Dim cpt&
Dim A$
Dim Ref$
Dim bool As Boolean
Dim T()
Set S = ActiveWorkbook.Sheets(DATA)
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&)
      If REF_ABS Then
        Ref$ = "$BD$"
      Else
        Ref$ = "BD"
      End If
      T(1, cpt&) = Ref$ & i&
    End If
  End If
Next i&
Set S = ActiveWorkbook.Sheets(CONTROLE)
S.Range("b16:iv16").ClearContents
If cpt& > 0 Then    '///ajout 26/01/09
  Set R = S.Range(S.Cells(16, 2), S.Cells(16, UBound(T, 2) + 1))
  R = T
End If      '///ajout  26/01/09
Call ctrl_form
End Sub

Merci d avance
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Macro de verification données images

Bonjour,

Je crois être, malheureusement, porteur d'une mauvaise nouvelle.
D'après le symptôme que vous décrivez, je subodore une écriture au-delà de la limite autorisée de 256 colonnes d'Excel.

Pour le vérifier faites tourner le code modifié où une alerte a été ajoutée
Code: 
Sub CleanImages() 'Contrôle Format Images
Dim var
Dim R As Range
Dim S As Worksheet
Dim i&
Dim cpt&
Dim A$
Dim Ref$
Dim bool As Boolean
Dim T()
Set S = ActiveWorkbook.Sheets(DATA)
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&)
      If REF_ABS Then
        Ref$ = "$BD$"
      Else
        Ref$ = "BD"
      End If
      T(1, cpt&) = Ref$ & i&
    End If
  End If
Next i&
Set S = ActiveWorkbook.Sheets(CONTROLE)
S.Range("b16:iv16").ClearContents
[COLOR="Red"]
'--- Test de dépassement du nombre autorisé de colonnes ---
MsgBox "Nombre d'erreurs = " & cpt& & vbCrLf & _
    "Nombre limite de colonnes Excel = " & Application.Columns.Count
'----------------------------------------------------------
[/COLOR]
If cpt& > 0 Then    '///ajout 26/01/09
  Set R = S.Range(S.Cells(16, 2), S.Cells(16, UBound(T, 2) + 1))
  R = T
End If      '///ajout  26/01/09
Call ctrl_form
End Sub

Si cela s'avère, 3 pistes pour solutionner le problème :
1) Changer complètement la structure de votre feuille de contrôle (ainsi que le code s'y rapportant). Au lieu d'organiser horizontalement le faire verticalement. En clair, au lieu d'avoir les titres des erreurs en ligne et les erreurs en colonne faire la transposition.
2) Inscrire les erreurs dans plusieurs onglets (mais si vous avez toutes vos 5000 et quelques lignes erronées, il faudra x onglets = nbErreur / 256).
3) Faire le contrôle, en plusieurs fois, sur un nombre restreint de lignes.

J'espère me tromper.

Cordialement.

PMO
Patrick Morange
 
Vote positif 0 Vote négatif
Re : Macro de verification données images

Bonjour,

Vous vous n'êtes pas trompé, Il s'avère bien que c'est un problème de limite de colonne autorisé, effectivement lorsque on dépasse 256 erreurs, il y a erreur.

Pour les Solutions proposés, je suis ouvert à la meilleurs à la simplicité et commodité

Soit on fait le contrôle, en plusieurs fois, sur un nombre restreint de lignes, mais es ce que cela ne va prendre bcp plus de tps ou de lenteur dans excel?

Soit on ajoute une MsgBox comme vous l'avez fait, qui dit : "il y a tant d' erreurs en colonne BD et merci de réduire à moins de 256 erreurs."
En cliquant sur OK, ca continue le processus de lancement des macros suivantes

Votre proposition, sera le mienne

Je vous remercie de votre aide

Cordialement
 
Vote positif 0 Vote négatif
Re : Macro de verification données images

Bonjour,

On fait au plus simple en arrétant le programme à partir d'un certain nombre d'erreurs.
L'utilisateur les corrigera tout d'abord puis pourra relancer le contrôle pour voir s'il en subsiste d'autres.

Le code actualisé de la routine
Code: 
Sub CleanImages() 'Contrôle Format Images
Dim var
Dim R As Range
Dim S As Worksheet
Dim i&
Dim cpt&
Dim A$
Dim Ref$
Dim bool As Boolean
Dim T()
Set S = ActiveWorkbook.Sheets(DATA)
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
      '--- Dépassement du nombre autorisé de colonnes ---
    If cpt& > 254 Then
      MsgBox cpt& & " erreurs ont été trouvées. Le programme ne peut en traiter plus." & vbCrLf & _
        "Il vous faudra relancer le programme, après correction, pour voir s'il en subsiste d'autres"
    End If
      '--------------------------------------------------
      ReDim Preserve T(1 To 1, 1 To cpt&)
      If REF_ABS Then
        Ref$ = "$BD$"
      Else
        Ref$ = "BD"
      End If
      T(1, cpt&) = Ref$ & i&
    End If
  End If
Next i&
Set S = ActiveWorkbook.Sheets(CONTROLE)
S.Range("b16:iv16").ClearContents
If cpt& > 0 Then    '///ajout 26/01/09
  Set R = S.Range(S.Cells(16, 2), S.Cells(16, UBound(T, 2) + 1))
  R = T
End If      '///ajout  26/01/09
Call ctrl_form
End Sub


Cordialement.

PMO
Patrick Morange
 
Vote positif 0 Vote négatif
Re : Macro de verification données images

Bonjour PMO2

Je reviens vers vous, car on avait fait au plus simple en arrétant le programme à partir d'un certain nombre d'erreurs.
L'utilisateur devait corriger tout d'abord et relancer le contrôle pour voir s'il en subsiste d'autres.

Du fait que je suis limité à 256 (excel n'a que 256 colonne), j'ai remodifier mon tableaux en vertical.

Comment dois je faire pour avoir les résultats erreurs en colonne ex (de P12 à P65536) et non plus en ligne 16?

Le code est
Code: 
Sub CleanImages() 'Contrôle Format Images
Dim var
Dim R As Range
Dim S As Worksheet
Dim i&
Dim cpt&
Dim A$
Dim Ref$
Dim bool As Boolean
Dim T()
Set S = ActiveWorkbook.Sheets(DATA)
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
      '--- Dépassement du nombre autorisé de colonnes ---
    If cpt& > 254 Then
      MsgBox cpt& & " erreurs ont été trouvées. Le programme ne peut en traiter plus." & vbCrLf & _
        "Il vous faudra relancer le programme, après correction, pour voir s'il en subsiste d'autres"
    End If
      '--------------------------------------------------
      ReDim Preserve T(1 To 1, 1 To cpt&)
      If REF_ABS Then
        Ref$ = "$BD$"
      Else
        Ref$ = "BD"
      End If
      T(1, cpt&) = Ref$ & i&
    End If
  End If
Next i&
Set S = ActiveWorkbook.Sheets(CONTROLE)
S.Range("b16:iv16").ClearContents
If cpt& > 0 Then    '///ajout 26/01/09
  Set R = S.Range(S.Cells(16, 2), S.Cells(16, UBound(T, 2) + 1))
  R = T
End If      '///ajout  26/01/09
Call ctrl_form
End Sub


Cordialement.
Merci d avance
 
Vote positif 0 Vote négatif
Re : Macro de verification données images

Bonjour,

Essayez avec le code suivant adapté

Code: 
Sub CleanImages() 'Contrôle Format Images
Dim var
Dim R As Range
Dim S As Worksheet
Dim i&
Dim cpt&
Dim A$
Dim Ref$
Dim bool As Boolean
Dim T()
Set S = ActiveWorkbook.Sheets(DATA)
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&)
      If REF_ABS Then
        Ref$ = "$BD$"
      Else
        Ref$ = "BD"
      End If
      T(1, cpt&) = Ref$ & i&
    End If
  End If
Next i&
Set S = ActiveWorkbook.Sheets(CONTROLE)
S.Range("p12:p65536").ClearContents
Set R = S.Range("P12:P" & UBound(T, 2) + 12 - 1 & "")
R = WorksheetFunction.Transpose(T)
Call ctrl_form
End Sub

Cordialement.

PMO
Patrick Morange
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Macro de verification données images

Bonjour,

A quoi sert ce code ?
R = WorksheetFunction.Transpose(T)
Cliquez pour agrandir...


On a le code suivant
Code: 
    If bool Then
      cpt& = cpt& + 1
      ReDim Preserve T(1 To 1, 1 To cpt&)
      If REF_ABS Then
        Ref$ = "$BD$"
      Else
        Ref$ = "BD"
      End If
      T(1, cpt&) = Ref$ & i&
    End If

Le tableau T est bi-dimensionné pour pouvoir par la suite être inscrit, d'un seul coup, dans une plage (Range).
Comme on ne sait pas, au départ, combien on aura d'anomalie on redimensionne le tableau T chaque fois qu'on en rencontre une en incrémentant le compteur cpt& et en utilisant l'instruction
ReDim Preserve T(1 To 1, 1 To cpt&)

Seule la dernière dimension d'un tableau multi-dimensionné peut être redimensionnée.

Le tableau T se présente comme ayant 1 ligne et plusieurs colonnes
" T(1 To 1, 1 To nombre de colonnes) ".
On peut l'inscrire dans une plage (Range) d'une ligne sur plusieurs colonnes MAIS si la plage (Range) est de plusieurs lignes sur une colonne, il y a lieu de transposer le tableau pour que ses lignes deviennent des colonnes ET que ses colonnes deviennent des lignes. D'où l'utilisation de l'instruction suivante qui transpose le tableau et l'inscrit dans le Range, celui-ci étant sur plusieurs lignes et sur une seule colonne.
Set R = S.Range("P12😛" & UBound(T, 2) - 1 & "") 'Range multi-lignes, une seule colonne
R = WorksheetFunction.Transpose(T)

Cordialement.

PMO
Patrick Morange
 
Vote positif 0 Vote négatif
Re : Macro de verification données images

Merci PMO2;Bonjour,

Je comprend pas ce qui se passe en essayant de faire ce que vous m avez dit, ca me donne pas les résultats erreurs en colonne (de P12 à P65536) ???

Je vous joins mon fichier

Merci
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Macro de verification données images

Bonjour,

Cela ne risque pas de fonctionner car j'ai fait une erreur.

Remplacez la ligne
Code: 
Set R = S.Range("P12:P" & UBound(T, 2) - 1 & "")

par la ligne
Code: 
[COLOR="Blue"]
Set R = S.Range("P12:P" & UBound(T, 2) + 12 - 1 & "")
[/COLOR]

Cordialement.

PMO
Patrick Morange
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

jeff1494
  • Résolu(e)
XL 2021 Extraction images depuis commentaire de cellule vers dossier.
11 12 13
Réponses
182
Affichages
3 K
patricktoulon
patricktoulon
R
  • Question Question
Macro recherche données
Réponses
8
Affichages
2 K
roidurif
R
Retour