Macro

Le 28/07/2008 à 11:06

Bonjour, voila j'ai fait cette macro :

Sub Macro1()

'

' Macro1 Macro

' Macro enregistrée le 28/07/2008 par Thomas

'

'

With ActiveSheet.QueryTables.Add(Connection:= _

"TEXT;C:\Documents and Settings\utilisateur\Bureau\24 07

08\air\fente15um\206-995\2bar\C1tir200000.txt" _

, Destination:=Range("A1"))

.Name = "C1tir200000"

.FieldNames = True

.RowNumbers = False

.FillAdjacentFormulas = False

.PreserveFormatting = True

.RefreshOnFileOpen = False

.RefreshStyle = xlInsertDeleteCells

.SavePassword = False

.SaveData = True

.AdjustColumnWidth = True

.RefreshPeriod = 0

.TextFilePromptOnRefresh = False

.TextFilePlatform = 850

.TextFileStartRow = 1

.TextFileParseType = xlDelimited

.TextFileTextQualifier = xlTextQualifierDoubleQuote

.TextFileConsecutiveDelimiter = False

.TextFileTabDelimiter = False

.TextFileSemicolonDelimiter = False

.TextFileCommaDelimiter = True

.TextFileSpaceDelimiter = False

.TextFileColumnDataTypes = Array(1, 1, 1, 1)

.TextFileDecimalSeparator = "."

.TextFileTrailingMinusNumbers = True

.Refresh BackgroundQuery:=False

End With

Columns("A:B").Select

Charts.Add

ActiveChart.ChartType = xlXYScatterSmoothNoMarkers

ActiveChart.SetSourceData Source:=Sheets("Feuil1").Range("A1:B10007"), _

PlotBy:=xlColumns

ActiveChart.Location Where:=xlLocationAsObject, Name:="Feuil1"

With ActiveChart

.HasTitle = True

.ChartTitle.Characters.Text = "16679 1 TrigTime 24/07/2008 11:47 Ampl"

.Axes(xlCategory, xlPrimary).HasTitle = True

.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Temps (s)"

.Axes(xlValue, xlPrimary).HasTitle = True

.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Tension (V)"

End With

ActiveSheet.Shapes("Graphique 1").IncrementLeft -63.75

ActiveSheet.Shapes("Graphique 1").IncrementTop -48#

ActiveChart.PlotArea.Select

With Selection.Border

.ColorIndex = 16

.Weight = xlThin

.LineStyle = xlContinuous

End With

With Selection.Interior

.ColorIndex = 2

.PatternColorIndex = 1

.Pattern = xlSolid

End With

ActiveChart.ChartTitle.Select

Selection.Left = 49

Selection.Top = 4

ActiveChart.Legend.Select

Selection.Left = 293

Selection.Top = 6

ActiveChart.Axes(xlValue).MajorGridlines.Select

ActiveChart.ChartArea.Select

ActiveChart.PlotArea.Select

Selection.Width = 423

ActiveChart.ChartArea.Select

ActiveChart.ChartArea.Select

ActiveSheet.Shapes("Graphique 1").ScaleWidth 1.6, msoFalse, _

msoScaleFromTopLeft

ActiveSheet.Shapes("Graphique 1").ScaleHeight 1.6, msoFalse, _

msoScaleFromTopLeft

Windows("Classeur2").ScrollColumn = 4

Windows("Classeur2").ScrollColumn = 3

Windows("Classeur2").ScrollColumn = 1

ActiveWorkbook.SaveAs Filename:= _

"C:\Documents and Settings\utilisateur\Bureau\24 07

08\air\fente15um\206-995\2bar\tir2.xls" _

, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _

ReadOnlyRecommended:=False, CreateBackup:=False

ActiveSheet.ChartObjects("Graphique 1").Activate

End Sub

Je voudrais que la macro me demande au début de choisir moi même le fichier, ainsi qu'à la fin pour l'enregistrement.

(Pour l'enregistrement : soit un choix, soit dans le même dossier que celui d'ouverture en renommant le fichier en tirX.xls si le fichier ouvert au début était C1tirX00000.txt , X étant un chiffre)

Est ce que vous pourriez m'aider svp?

Fichier texte ici si vous voulez les tabulations pour plus de lisibilité

https://www.excel-pratique.com/~files/doc/zYaPumacro.txt

Le 28/07/2008 à 14:17

Bonjour,

essaie avec ce code (non testé)

remplace le début de ton code par ceci :

Sub Macro1()
Dim FileToOpen As Variant
      FileToOpen = Application.GetOpenFilename("Fichiers Texte (*.txt), *.txt")
      If FileToOpen = False Then Exit Sub
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & FileToOpen, Destination:=Range("A1"))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1)
        .TextFileDecimalSeparator = "."
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

et la fin par ceci :

LePath = ActiveWorkbook.Path & "\"
LeNom = Mid(FileToOpen, InStr(1, FileToOpen, "tir"), 4) & ".xls"
ActiveWorkbook.SaveAs Filename:=LePath & LeNom
ActiveSheet.ChartObjects("Graphique 1").Activate
End Sub
Le 28/07/2008 à 14:46

J'ai une erreur d'execution 1004 dans le début. "Impossible de trouver le fichier texte pour l'actualisation de cette plage de données externes"

d'apres le debogueur elle arrive juste apres le refresh background query.

J'ai pas encore testé la fin

au passage que faire des

Windows("Classeur2").ScrollColumn = 4

Windows("Classeur2").ScrollColumn = 3

Windows("Classeur2").ScrollColumn = 1

si mon classeur ne s'appelle pas classeur2 je suppose que ca fait planté non?

Le 28/07/2008 à 14:54

Re-,

comme je ne peux pas tester, pas facile

sinon, as-tu effectivement enlevé le .Name = "C1tir200000" ?

pour les Scroll, tu peux les enlever, il ne servent qu'à déplacer la barre de défilement, donc à rien...

Le 28/07/2008 à 15:00

oui j'ai enlevé le .Name

ok pour les scroll

pas grave je vaisfinir en manuel il me reste qu'une trentaines de fichiers je pense

Le 28/07/2008 à 15:05

Re-,

si cela n'est pas confidentiel, peux-tu joindre ton fichier C1tir200000.txt?

ou sinon, je peux t'envoyer mon adresse mail en messagerie privée

Le 28/07/2008 à 15:30

https://www.excel-pratique.com/~files/doc/C1tir200000.txt

je l'ai réduit normalement il fait 10 0000 lignes environ !!

Le 28/07/2008 à 15:36

Re-,

chez moi, cela fonctionne parfaitement...

Tes fichiers texte sont bien dans le même répertoire?

le code que j'utilises :

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 28/07/2008 par Thomas MARTINEAU
'

'
Dim FileToOpen As Variant
      FileToOpen = Application.GetOpenFilename("Fichiers Texte (*.txt), *.txt")
      If FileToOpen = False Then Exit Sub
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & FileToOpen, Destination:=Range("A1"))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1)
        .TextFileDecimalSeparator = "."
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
Columns("A:B").Select
Charts.Add
ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
ActiveChart.SetSourceData Source:=Sheets("Feuil1").Range("A1:B10007"), _
PlotBy:=xlColumns
ActiveChart.Location Where:=xlLocationAsObject, Name:="Feuil1"
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "16679 1 TrigTime 24/07/2008 11:47 Ampl"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Temps (s)"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Tension (V)"
End With
ActiveSheet.Shapes("Graphique 1").IncrementLeft -63.75
ActiveSheet.Shapes("Graphique 1").IncrementTop -48#
ActiveChart.PlotArea.Select
With Selection.Border
.ColorIndex = 16
.Weight = xlThin
.LineStyle = xlContinuous
End With
With Selection.Interior
.ColorIndex = 2
.PatternColorIndex = 1
.Pattern = xlSolid
End With
ActiveChart.ChartTitle.Select
Selection.Left = 49
Selection.Top = 4
ActiveChart.Legend.Select
Selection.Left = 293
Selection.Top = 6
ActiveChart.Axes(xlValue).MajorGridlines.Select
ActiveChart.ChartArea.Select
ActiveChart.PlotArea.Select
Selection.Width = 423
ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Select
ActiveSheet.Shapes("Graphique 1").ScaleWidth 1.6, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Graphique 1").ScaleHeight 1.6, msoFalse, _
msoScaleFromTopLeft
LePath = ActiveWorkbook.Path & "\"
LeNom = Mid(FileToOpen, InStr(1, FileToOpen, "tir"), 4) & ".xls"
ActiveWorkbook.SaveAs Filename:=LePath & LeNom
ActiveSheet.ChartObjects("Graphique 1").Activate
End Sub
Le 28/07/2008 à 15:47

non le répertoire change, mais je pensais que le repertoire allait aussi dans FileToOpen.. ce qui expliquerait tout

Le 28/07/2008 à 15:57

Re-,

même en changeant de répertoire, cela fonctionne

Par contre, l'erreur vient peut-être de ces lignes :

....
'ActiveSheet.Shapes("Graphique 1").IncrementLeft -63.75
'ActiveSheet.Shapes("Graphique 1").IncrementTop -48#
....
....
'ActiveSheet.Shapes("Graphique 1").ScaleWidth 1.6, msoFalse, _
msoScaleFromTopLeft
'ActiveSheet.Shapes("Graphique 1").ScaleHeight 1.6, msoFalse, _
msoScaleFromTopLeft
....
....
'ActiveSheet.ChartObjects("Graphique 1").Activate
End Sub

Fais comme moi, mets un quote ( ' ) devant les lignes, pour voir

Le 28/07/2008 à 16:11

Merci bcp ca marche meme avec les graphique 1 maintenant...

ca va m'epargner pas mal de temps super..

y'a juste l'enregistrement qui se fait dans c:

alors que je le voudrais dans le même répertoire que le fichier qui a été ouvert mais en manuel ca passera

Le 28/07/2008 à 16:11

Merci bcp ca marche meme avec les graphique 1 maintenant...

ca va m'epargner pas mal de temps super..

y'a juste l'enregistrement qui se fait dans c:

alors que je le voudrais dans le même répertoire que le fichier qui a été ouvert mais en manuel ca passera

oups double post

Le 28/07/2008 à 16:16

Re-,

remplace cette ligne :

LePath = Mid(FileToOpen, 1, InStr(1, FileToOpen, "tir") - 3)
Le 28/07/2008 à 16:25

c'est énorme la mise en forme des graphs prend plus de temps que l'importation des données....

encore merci

Le 28/07/2008 à 20:00

Re-,

comme j'ai pas trouvé le smiliey de V_Elbie

Si c'est résolu, peux-tu le signaler?

pour ce faire, dans ton premier fil tu as une option, il me semble, où tu peux choisir "Résolu"

Le 28/07/2008 à 20:18

non y'a pas, mais c'est résolu j'aime terminé tous les fichiers que j'avais à faire. encore merci

Le 28/07/2008 à 20:24

Re-,

comme je n'ai pas posé de question, je ne te saurai te dire où se trouve l'option....

Mais elle existe

Si quelqu'un pouvait te l'indiquer

Merci

Rechercher des sujets similaires à "macro"