Transferer les chiffres qui se trouvent sur une foto sur.....

[Guido]

Bonsoir le Forum

J'aimerais extraire le chiffre qui se trouvent sur une image dans une cellule,

Voir le fichier..

Merci d'avance

Guido

 

[Guido]

Re

???C'est dingue ,j'etais entrain de voir la solution sur le site..

Je recheche meme a faire afficher les 6 ou 7 premier de chaque course en partant de

la droite passer a la ligne suivante et puis anouveau ligne suivante a droite ainsi de suite

Je posterais ce soir le fichier complet...

Merci a Tous

Bon app

Guido

 

[Usine à gaz]

Bonjour à toutes et à tous,
Bonjour Job75,
Vous êtes un magicien
Je trouve que votre fil est super intéressant et je me permets de m'immiscer.
Bien évidemment, si je venais à vous déranger dans vos réponses à Guido, il vous suffit de ne pas me répondre (je comprendrai et ne m'en offusquerai pas ).
J'ai donc suivi et tout testé.
J'ai également voulu voir si vos codes pouvaient extraire les chiffres de mes photos et j'en ai mis 2 dans le classeur.
C'e sont des photos au format JPEG :
- une qui est la copie écran des propriétés de la seconde,

- Une autre à laquelle j'ai introduis des chiffres en texte. (je l'ai positionné à gauche de D12)
Test négatif, ça ne fonctionne pas.

Questions :
- Quel est le type des photos qui sont dans le classeur ?,

Vos codes peuvent-il extraire les chiffres :
- de tous types de photos ?,
- JPEG ?,

J'ai préparé un classeur en partant du classeur de Guido auquel j'ai ajouté vos codes.
Je joins le classeur ainsi que les photos.
Si ça vous tente ......
Amicalement,
Lionel,

 

[Guido]

Re

Pas de probleme

Je reviens dans l'apres midi

Bon APP

Amiiés

Guido

 

[job75]

Bonjour arthour973,

La propriété AlternativeText de votre Shape ne contient rien :

Sub Test()
MsgBox ActiveSheet.Shapes("Image 1").AlternativeText
End Sub

A+

 

[Usine à gaz]

Merci de m'avoir répondu Job75,

Je ne connaissais pas La propriété AlternativeText.
Je suis sur ce site :
Ce lien n'existe plus
@plus,
Amicalement,
Lionel,

 

[Usine à gaz]

J'avoue que je n'y comprends pas grand chose
J'ai téléchargé une photo sur le net et je ne vois pas où ce se trouve la propriété AlternativeText dans les propriétés.
Lionel,

 

[Guido]

Bonsoir le Forum

Question j'aimerais vous faire parvenir mon fichier en Zip

Quelle le poids max

Merci

Guido

 

[job75]

Re arthour973,

AlternativeText n'est pas une propriété d'un fichier JPEG mais celle d'une image dans un fichier Excel !!!

Sur Excel 2013 => TEXTE DE REMPLACEMENT.

Bonne fin de soirée.

 

[Guido]

Re

Ma demande..

J'aimerairais faire afficher les numeros qui sont sur l'image

des chevaux ensuite Ont extrais de droite a Gaucheet

vers le bas

Voir exemple.

Ensuite faire afficher par Reunion et par Courses

ainsi de suite

Merci

Guido

 

[job75]

Bonjour Guido, le forum,

Je m'intéresserai à la question quand elle sera cohérente.

Dans l'exemple les numéros des chevaux en colonnes E F G ne correspondent pas aux titres :

CHEVAL 1 Colonne B --- CHEVAL 2 Colonne C --- CHEVAL 3 Colonne D

Bonne journée.

 

[Guido]

Bonjour Job75

Oui,ma tete a fais a l'envers

Donc dans l'exemple les numéros des chevaux en colonnes E F G ne correspondent aux titres

CHEVAL 1 Colonne D --- CHEVAL 2 Colonne C --- CHEVAL 3 Colonne B

merci pour ta remarque.

a plus

Guido

 

[job75]

Re,

Cela ne correspond toujours pas à votre exemple !

Mais je n'irai pas plus loin :

Sub Tiercé()
Dim s As Shape, lig&, col%, at$, sp
Application.ScreenUpdating = False
[E:G].Clear 'RAZ
For Each s In ActiveSheet.Shapes
  lig = s.TopLeftCell.Row
  col = s.TopLeftCell.Column
  at = s.AlternativeText
  sp = Split(at, "_")
  If at Like "hippodrome*" Then
    Cells(lig + 2, 5) = "CHEVAL 1 COLONNE D"
    Cells(lig + 2, 6) = "CHEVAL 2 COLONNE C"
    Cells(lig + 2, 7) = "CHEVAL 3 COLONNE B"
    Cells(lig + 2, 5).Resize(, 3).Interior.Color = 13434828
    Cells(lig + 2, 5).Resize(, 3).Borders.Weight = xlThin
  ElseIf UBound(sp) > 0 Then
    If col = 2 Then Cells(lig, 7) = Replace(sp(1), "vide", "")
    If col = 3 Then Cells(lig, 6) = Replace(sp(1), "vide", "")
    If col = 4 Then Cells(lig, 5) = Replace(sp(1), "vide", "")
    Cells(lig, 5).Resize(2, 3).Interior.Color = 10079487
    Cells(lig, 5).Resize(2, 3).Borders.Weight = xlThin
  End If
Next
End Sub

A+

 

[Guido]

Re

Job75 Merci pour cette avancée.

Comment... procedé pour transferé les trios qui se trouve dans la page ARRIVEES VIRTUELLE

dans la feuille PRONO TRIO selon la R1..et les courses possibles....2...3...4...5...6...7...8...9

et ainsi de suite .Un petit exemple dans la feuille PRONOS TRIO..

Comment effacer le contenu et couleurs de la feuille ARRIVEES VIRTUELLE LIVE

sans supprimer le boutons de la macro...

Merci d'avance

Amitiées

Guido

 

[job75]

Re,

La macro du bouton (ActiveX) :

Private Sub CommandButton1_Click()
Dim s As Shape, lig&, col%, at$, sp, c As Range, flag As Boolean, r As Range, n%
Application.ScreenUpdating = False
[E:G].Clear
For Each s In Shapes
  lig = s.TopLeftCell.Row
  col = s.TopLeftCell.Column
  at = s.AlternativeText
  sp = Split(at, "_")
  If at Like "hippodrome*" Then
    Cells(lig + 2, 5).Resize(, 3).Interior.Color = 13434828
  ElseIf UBound(sp) > 0 Then
    If col = 2 Then Cells(lig, 7) = sp(1)
    If col = 3 Then Cells(lig, 6) = sp(1)
    If col = 4 Then Cells(lig, 5) = sp(1)
    Cells(lig, 5).Resize(2, 3).Interior.Color = 10079487
  End If
Next s
With Sheets("PRONOS TRIO")
  For Each c In .UsedRange
    If c = "CHX" Then c(1, 2).Resize(, 6) = "" 'RAZ
  Next c
  For Each c In Intersect([E:G], Me.UsedRange.EntireRow)
    If c.Interior.ColorIndex = xlNone Then flag = False
    If Not flag And c.Interior.Color = 13434828 Then
      flag = True
      sp = Split(c(-2, -2), "C") 'références de la course
      Set r = Nothing
      n = 0
      If UBound(sp) > 0 Then
        Set r = .Cells.Find(sp(0), , xlValues, xlWhole)
        If Not r Is Nothing Then Set r = r.EntireColumn.Find("Course " & sp(1))
        If Not r Is Nothing Then Set r = r(2, 2).Resize(, 6)
      End If
    ElseIf flag And Not r Is Nothing And IsNumeric(CStr(c)) Then
      n = n + 1
      If n < 7 Then r(n) = c
    End If
  Next c
  [E:G].Delete
  .Activate
End With
End Sub

Il y avait 2 espaces dans le nom de la feuille PRONOS TRIO, un seul suffit...

Fichier zippé joint.

Edit : vous aviez oublié une colonne pour le tableau R7...

A+

 

[job75]

Re,

La course R3C5 (cellule B135) n'était pas reportée dans la feuille PRONOS TRIO.

Par inadvertance j'avais effacé l'image référencée "hippodrome002" en B136.

J'ai donc corrigé le fichier.

Bonne nuit.