Sujet Précédent Sujet Suivant

Exportation de données issues d'un Tif (VBA)

Fermé
jaromyr - 26 oct. 2007 à 16:28
 Utilisateur anonyme - 27 oct. 2007 à 13:27
Bonjour,

Bonjour à tous,

Cela fait bientôt une semaine que je lis avec beaucoup de plaisir vos rubriques sur le VBA de manière à ce que le néofite que je suis, ne le soit plus dans ce domaine.

- Voici ma problèmatique:
je souhaiterai extraire des données d'images en Tif en provenance d'un microscope afin de les acheminer dans une base access.

- Mon raissonnement :

Etant débutant, je me suis dit qu'il était facile de demander à excell d'ouvrir un tiff et d'extraire des données dans un tableau puis ensuite de demander soit à access ou excell de remettre le tout dans ma base de données déjà constituée.

- Difficultés rencontrées en ordre croissant:
Dans le script vba ainsi construit j'aimerai

1) pouvoir appliquer cette extraction sur plusieurs images (et pas qu'une seul)
2) l'extraction ainsi réalisé pourvoir "convertir" de façon avoir sur une colone les parametres et sur une autre colone les résultats.
3) Peut être existe-il une solution plus direct en passant directement avec un script vba sous access..

- Mon script VBA :

Private Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 19/10/2007 par jfl
' Pour extraire tt les données d'une image tiff

'
'Pour mettre en boucle ...
'Dim Chemin As String, Fichier As String

'Chemin = "C:\scriptmeb\"
'Fichier = Dir(Chemin & "*.tif")

'Do While Len(Fichier) > 0
'Debug.Print Chemin & Fichier
'Fichier = Dir()
'Loop


Application.CommandBars("Stop Recording").Visible = False
Application.Goto Reference:="Macro1"

Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim waExcel: Set waExcel = CreateObject("Excel.Application") 'Ouverture d'Excel
StrPath = "C:\scriptmeb\" 'Chemin d'accès du fichier
If Right(StrPath, 1) <> "\" Then StrPath = StrPath & "\" 'Ajoute \ à la fin s'il y en a pas
StrFich = "HI 07035 A.tif" 'Nom du fichier
If FSO.FileExists(StrPath & StrFich) Then 'Existance du fichier
waExcel.Visible = False 'Rendre invisible Excel
'Importe le fichier texte vers une feuille Excel de façon Largeur fixe avec délimiteur : Tabulation et Space et =
waExcel.Workbooks.OpenText StrPath & StrFich, , 151, 2, , , True, , , True, True, "="
'waExcel.Workbooks.OpenText StrPath & StrFich, , , 2, , , , , ,
'Sauvegarde la feuiller importer vers le chemin d'accès de départ en motifiant l'extension et en mode partagé pour éviter des erreurs
waExcel.Workbooks(StrFich).SaveAs StrPath & Left(StrFich, Len(StrFich) - 4) & ".xls", , , , , , 2
End If
'Fermeture d'Excel
waExcel.Application.Quit

End Sub



Voili voilou,
Merci par avance quant à vos divers éléments de réponse.

Cordialement,

Jaromyr

2 réponses

Réponse 1 / 2
Utilisateur anonyme
26 oct. 2007 à 21:28
Bonjour,

suggestion :

n.b. j'ai pas tout testé, et certaines instructions me semble encore superflus
mais avant de tout changer, et de vous perdre ... ??? 

Option Explicit
'

Private Sub Importation()

    'Pour mettre en boucle ...
    Dim Chemin As String, objFichier As Variant
    
    Chemin = "C:\scriptmeb\"
    objFichier = Dir(Chemin & "*.tif")
    
    Do While (objFichier <> "")
        'MsgBox "Fichier : " & objFichier    ' Affiche l'entrée
        Traitement objFichier
        objFichier = Dir                    ' Extrait l'entrée suivante.
    Loop

End Sub
'

Function Traitement(ByVal objFic As Variant)
    
    'Application.CommandBars("Stop Recording").Visible = False
    'Application.Goto Reference:="Macro1"
    
    Dim FSO As Object, strPath As String, strFich As String

    Set FSO = CreateObject("Scripting.FileSystemObject")
    strPath = "C:\scriptmeb\" 'Chemin d'accès du fichier
    
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\" 'Ajoute \ à la fin s'il y en a pas
    'strFich = "HI 07035 A.tif" 'Nom du fichier
    If FSO.FileExists(strPath & objFic) Then 'Existance du fichier
        Workbooks.OpenText strPath & objFic, , 151, 2, , , True, , , True, True, "="
        'Sauvegarde la feuiller importer vers le chemin d'accès de départ en motifiant l'extension et en mode partagé pour éviter des erreurs
        Workbooks(objFic).SaveAs strPath & Left(objFic, Len(objFic) - 4) & ".xls", , , , , , 2
    End If
    ActiveWorkbook.Close

End Function


Lupin
0
Réponse 2 / 2
Utilisateur anonyme
27 oct. 2007 à 13:27
Bonjour,

continuité :

bon voici la moulinette pour traiter tous les fichiers tif d'un répertoire donné.
Je n'ai jamis importer de fichier tif dans excel. Quel genre d'importation cela
produit-il ??? Votre définition d'importation fonctionne pour un fichier vide
que j'ai nommé [ 1.tif ].

Avez-vous un fichier tif non-confidentiel que vous pourriez me fournir comme exemple ?

Voilà encore quelques modifications : 

Option Explicit
'

Private Sub Importation()

    Dim Chemin As String, objFichier As Variant, Reponse As Boolean
    
    Chemin = "C:\scriptmeb\"
    objFichier = Dir(Chemin & "*.tif")
    
    Do While (objFichier <> "")
        Reponse = Traitement(Chemin, objFichier)
        If (Not (Reponse)) Then
            MsgBox "Erreur sur le fichier : " & Chemin & objFichier
        End If
        objFichier = Dir               ' Extrait l'entrée suivante.
    Loop

End Sub
'

Private Function Traitement(strChemin As String, objFic As Variant) As Boolean
    
    Dim FSO As Object

    Traitement = False
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    If FSO.FileExists(strChemin & objFic) Then 'Existance du fichier
        Workbooks.OpenText strChemin & objFic, , 151, 2, , , True, , , True, True, "="
        ' Sauvegarde la feuiller importer vers le chemin d'accès de départ en motifiant
        ' l'extension et en mode partagé pour éviter des erreurs
        ActiveWorkbook.SaveAs strChemin & Left(objFic, Len(objFic) - 4) & ".xls", , , , , , 2
        ' Traitement VBA
        ' Code
        ' ...
    End If
    ActiveWorkbook.Close
    Traitement = True

End Function
'


Cordialement

Lupin
0

Discussions similaires

convertir ou ouvrir un document en tif ??
bmw5478 -
maclotmichel -

12 réponses
ouvrir un document .tif
fred97 -
aleglezu -

14 réponses
LECTURE FICHIERS TIF
sinfonic -
zaboukou -

6 réponses
"L'indice n'appartient à la sélection" + VBA
fleur.31 -
geosevda -

2 réponses
ouverture d'un fichier excel à partir d'un code VBA
TraderAS -
pijaku -

3 réponses