Exportation de données issues d'un Tif (VBA)
jaromyr
-
Utilisateur anonyme -
Utilisateur anonyme -
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
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
A voir également:
- Exportation de données issues d'un Tif (VBA)
- Fuite données maif - Guide
- Supprimer les données de navigation - Guide
- La zone de données passée à un appel système est insuffisante - Windows 11
- Trier des données excel - Guide
- Incompatibilité de type vba ✓ - Forum Programmation
2 réponses
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 ... ???
Lupin
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
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 :
Cordialement
Lupin
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
