Ouvrir des fichier txt a partir d'un fichier Excel en VBA
Bonjour
J'ai un fichier excel tbt et j'aimerais avoir une macro( qui m'ouvrira tout seul des fichiers txt qui sont situer tous au même endroit sur le bureau). et sur ces fichiers txt j'effectue d'autre macro(du style des opération ) qui se placeront dans mon fichier excel tbt.
sachant que j'ai tout les mois des nouveaux fichiers txt (au moins 60) j'aimerais automatiser ce travail mais je vois pas du tout comment faire cette macro
Merci infiniment pour votre précieuse aide
bonjour,
merci de mettre des fichiers exemple (TXT, TBT) ainsi que les opérations que tu ferais manuellement pour obtenir le résultat que tu veux automatiser.
voici mon fichier tbt (ceux que je veux remplir c les onglet jaune) et un des fichier txt (tout les moi j'en ai un, la j'ai fait seulement pour 1 seul contrat )
voici les macro que j'ai fait jusqu'a maintenant je convertisser mon fichier txt en excel j'effectuer les macro et après je coller sur mon fichier tbt
Sub NOMBRE_ADHESION_TECHNIQUE()
Dim Date_Souscription_Adhésion As Range
Dim DernLigne As Long
Dim nblignes(1 To 12, 2013 To 2017) As Long
Dim i, j, k As Integer
Dim a, b, c, d, e As Integer
With Worksheets("Sinistre_101")
DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
Set Date_Souscription_Adhésion = .Range("F2:F" & DernLigne)
End With
a = LBound(nblignes, 2)
e = UBound(nblignes, 2)
For i = 2 To DernLigne
j = Month(Cells(i, 6).Value)
k = Year(Cells(i, 6).Value)
nblignes(j, k) = nblignes(j, k) + 1
Next i
For i = 1 To 12
For k = a To e
Sheets("Feuil1").Cells(i + (k - 2013) * 12, 2).Value = nblignes(i, k)
Next k
Next i
End Sub
Sub NOMBRE_DE_SINISTRES_DECLARES()
Dim Date_Souscription_Adhésion As Range, Date_Survenance As Range
Dim DernLigne As Long
Dim nblignes(1 To 12, 2013 To 2017) As Long
Dim i, j, k As Integer
Dim a, b, c, d, e As Integer
With Worksheets("Sinistre_101")
DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
Set Date_Souscription_Adhésion = .Range("G2:G" & DernLigne)
Set Date_Survenance = .Range("U2:U" & DernLigne)
End With
a = LBound(nblignes, 2)
e = UBound(nblignes, 2)
For i = 2 To DernLigne
If a <= Year(Cells(i, 21).Value) And Year(Cells(i, 21).Value) <= e Then
j = Month(Cells(i, 7).Value)
k = Year(Cells(i, 7).Value)
nblignes(j, k) = nblignes(j, k) + 1
End If
Next i
For i = 1 To 12
For k = a To e
Sheets("Feuil1").Cells(i + (k - 2013) * 12, 3).Value = nblignes(i, k)
Next k
Next i
End Sub
Sub NOMBRE_DE_SINISTRES_ACCEPTES()
Dim Date_Souscription_Adhésion As Range, Date_Survenance, Statut_Technique_Sinistre As Range
Dim DernLigne As Long
Dim nblignes(1 To 12, 2013 To 2017) As Long
Dim i, j, k As Integer
Dim a, b, c, d, e As Integer
Dim s As String
With Worksheets("Sinistre_101")
DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
Set Date_Souscription_Adhésion = .Range("G2:G" & DernLigne)
Set Date_Survenance = .Range("U2:U" & DernLigne)
Set Statut_Technique_Sinistre = .Range("V2:V" & DernLigne)
End With
a = LBound(nblignes, 2)
e = UBound(nblignes, 2)
For i = 2 To DernLigne
s = Cells(i, "V").Value
If s = "Terminé - accepté" Then
If a <= Year(Cells(i, 21).Value) And Year(Cells(i, 21).Value) <= e Then
j = Month(Cells(i, 7).Value)
k = Year(Cells(i, 7).Value)
nblignes(j, k) = nblignes(j, k) + 1
End If
End If
Next i
For i = 1 To 12
For k = a To e
Sheets("Feuil1").Cells(i + (k - 2013) * 12, 4).Value = nblignes(i, k)
Next k
Next i
End Sub
Sub Taux_Accp()
Dim Sinistre_Accepte As Range
Dim Sinistre_Declare As Range
Dim DernLigne1 As Long
Dim i As Integer
With Worksheets("Feuil1")
DernLigne1 = .Range("A" & .Rows.Count).End(xlUp).Row
Set Sinistre_Accepte = .Range("D1:D" & DernLigne1)
Set Sinistre_Declare = .Range("C1:C" & DernLigne1)
End With
'Total = Nombre_Sinistre_Accepte / Nombre_Sinistre_Declare
For i = 2 To DernLigne1
If Cells(i, 3).Value = 0 Then
Cells(i, 5).Value = 0
Else
Cells(i, 5).Value = Cells(i, 4).Value / Cells(i, 3).Value
End If
Next i
End Sub
Sub MONTANT_INDEMNITE_PRINCIPALE()
Dim Date_Souscription_Adhésion As Range, Statut_Technique_Sinistre As Range
Dim Montant_Ind_Principale As Range
Dim DernLigne As Long
Dim i As Integer
Dim sa As String
Dim montant As String
Dim tt(2013 To 2017, 1 To 12) As Double
'tmois = Split("janvier,février,mars,avril,mai,juin,juillet,août,septembre,octobre,novembre,décembre", ",")
With Worksheets("Sinistre_101")
DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
Set Date_Souscription_Adhésion = .Range("G2:G" & DernLigne)
Set Montant_Ind_Principale = .Range("AB2:AB" & DernLigne)
Set Statut_Technique_Sinistre = .Range("V2:V" & DernLigne)
For i = 2 To DernLigne
sa = .Cells(i, 22)
montant = Replace(.Cells(i, 28), ".", ",")
annee = Year(.Cells(i, 7).Value)
Mois = Month(.Cells(i, 7).Value)
If sa <> "Terminé - Refusé après instruction" Then
tt(annee, Mois) = tt(annee, Mois) + CDbl(montant)
End If
Next i
For annee = 2013 To 2017
For Mois = 1 To 12
j = j + 1
' Sheets("Feuil2").Cells(j, 2).Value = tmois(Mois - 1) & " " & annee
Sheets("Feuil1").Cells(j, 6).Value = tt(annee, Mois)
Next Mois
Next annee
End With
End Sub
Sub MONTANT_FRAIS_ANNEXE()
Dim Date_Souscription_Adhésion As Range, Statut_Technique_Sinistre As Range
Dim Frais_Annexe As Range
Dim DernLigne As Long
Dim i As Integer
Dim sa As String
Dim frais As String
Dim tt(2013 To 2017, 1 To 12) As Double
With Worksheets("Sinistre_101")
DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
Set Date_Souscription_Adhésion = .Range("G2:G" & DernLigne)
Set Frais_Annexe = .Range("AC2:AC" & DernLigne)
Set Statut_Technique_Sinistre = .Range("V2:V" & DernLigne)
For i = 2 To DernLigne
sa = .Cells(i, 22)
frais = Replace(.Cells(i, 29), ".", ",")
annee = Year(.Cells(i, 7).Value)
Mois = Month(.Cells(i, 7).Value)
If sa <> "Terminé - Refusé après instruction" Then
tt(annee, Mois) = tt(annee, Mois) + CDbl(frais)
End If
Next i
For annee = 2013 To 2017
For Mois = 1 To 12
j = j + 1
Sheets("Feuil1").Cells(j, 7).Value = tt(annee, Mois)
Next Mois
Next annee
End With
End Sub
Sub MONTANT_REPRISE()
Dim Date_Souscription_Adhésion As Range, Statut_Technique_Sinistre As Range
Dim Somme_Montant_Reprise As Range
Dim DernLigne As Long
Dim i As Integer
Dim sa As String
Dim reprise As String
Dim tt(2013 To 2017, 1 To 12) As Double
With Worksheets("Sinistre_101")
DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
Set Date_Souscription_Adhésion = .Range("G2:G" & DernLigne)
Set Somme_Montant_Reprise = .Range("AD2:AD" & DernLigne)
Set Statut_Technique_Sinistre = .Range("V2:V" & DernLigne)
For i = 2 To DernLigne
sa = .Cells(i, 22)
reprise = Replace(.Cells(i, 30), ".", ",")
annee = Year(.Cells(i, 7).Value)
Mois = Month(.Cells(i, 7).Value)
If sa <> "Terminé - Refusé après instruction" Then
tt(annee, Mois) = tt(annee, Mois) + CDbl(reprise)
End If
Next i
For annee = 2013 To 2017
For Mois = 1 To 12
j = j + 1
Sheets("Feuil1").Cells(j, 8).Value = tt(annee, Mois)
Next Mois
Next annee
End With
End Sub
Sub MONTANT_TOTAL_REGLEMENT()
Dim Date_Souscription_Adhésion As Range, Statut_Technique_Sinistre As Range
Dim Somme_Montant_Total_Reglement As Range
Dim DernLigne As Long
Dim i As Integer
Dim sa As String
Dim total As String
Dim tt(2013 To 2017, 1 To 12) As Double
With Worksheets("Sinistre_101")
DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
Set Date_Souscription_Adhésion = .Range("G2:G" & DernLigne)
Set Somme_Montant_Total_Reglement = .Range("AE2:AE" & DernLigne)
Set Statut_Technique_Sinistre = .Range("V2:V" & DernLigne)
For i = 2 To DernLigne
sa = .Cells(i, 22)
total = Replace(.Cells(i, 31), ".", ",")
annee = Year(.Cells(i, 7).Value)
Mois = Month(.Cells(i, 7).Value)
If sa <> "Terminé - Refusé après instruction" Then
tt(annee, Mois) = tt(annee, Mois) + CDbl(total)
End If
Next i
For annee = 2013 To 2017
For Mois = 1 To 12
j = j + 1
Sheets("Feuil1").Cells(j, 9).Value = tt(annee, Mois)
Next Mois
Next annee
End With
End Sub
Sub CHARGES_SINISTRES_REFUSE()
Dim Date_Souscription_Adhésion As Range, Statut_Technique_Sinistre As Range
Dim Frais_Annexe As Range
Dim DernLigne As Long
Dim i As Integer
Dim sa As String
Dim refus As String
Dim tt(2013 To 2017, 1 To 12) As Double
With Worksheets("Sinistre_101")
DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
Set Date_Souscription_Adhésion = .Range("G2:G" & DernLigne)
Set Frais_Annexe = .Range("AC2:AC" & DernLigne)
Set Statut_Technique_Sinistre = .Range("V2:V" & DernLigne)
For i = 2 To DernLigne
sa = .Cells(i, 22)
refus = Replace(.Cells(i, 29), ".", ",")
annee = Year(.Cells(i, 7).Value)
Mois = Month(.Cells(i, 7).Value)
If sa = "Terminé - Refusé après instruction" Then
tt(annee, Mois) = tt(annee, Mois) + CDbl(refus)
End If
Next i
For annee = 2013 To 2017
For Mois = 1 To 12
j = j + 1
Sheets("Feuil1").Cells(j, 10).Value = tt(annee, Mois)
Next Mois
Next annee
End With
End Sub
Sub fraisgeneraux()
End Sub
Sub participationaubenefice()
End Sub
Sub Resultat_Net_AVEC_ICI()
Dim Prime_ICI As Range
Dim Somme_Montant_Total_Reglement As Range
Dim i As Integer
Dim DernLigne As Long
With Worksheets("Feuil1")
DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
Set Prime_ICI = .Range("R1:R" & DernLigne)
Set Somme_Montant_Total_Reglement = .Range("I1:I" & DernLigne)
End With
For i = 1 To DernLigne
'Resultat_Net_ICI = Prime_ICI - Somme_Montant_Total_Reglement
Cells(i, 13).Value = Cells(i, 18).Value - Cells(i, 9).Value
Next i
End Sub
Sub Resultat_Net_SANS_ICI()
Dim Prime_SANS_ICI As Range
Dim Somme_Montant_Total_Reglement As Range
Dim i As Integer
Dim DernLigne As Long
With Worksheets("Feuil1")
DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
Set Prime_SANS_ICI = .Range("S1:S" & DernLigne)
Set Somme_Montant_Total_Reglement = .Range("I1:I" & DernLigne)
End With
For i = 1 To DernLigne
'Resultat_Net_SANS_ICI = Prime_SANS_ICI - Somme_Montant_Total_Reglement
Cells(i, 14).Value = Cells(i, 19).Value - Cells(i, 9).Value
Next i
End Sub
Sub Sinistre_Sur_Prime_ici()
Dim Somme_Montant_Total_Reglement As Range
Dim Prime_ICI As Range
Dim Sinistre_Sur_Prime_ici As Double
Dim DernLigne As Long
Dim i As Integer
With Worksheets("Feuil1")
DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
Set Prime_ICI = .Range("R1:R" & DernLigne)
Set Somme_Montant_Total_Reglement = .Range("I1:I" & DernLigne)
End With
For i = 2 To DernLigne
'Sinistre_Sur_Prime_ICI = Somme_Montant_Total_Reglement / Prime_ICI
Cells(i, 15).Value = Cells(i, 9).Value / Cells(i, 18).Value
Next i
End Sub
Sub Sinistre_Sur_Prime_sans_ici()
Dim Somme_Montant_Total_Reglement As Range
Dim Prime_SANS_ICI As Range
Dim Sinistre_Sur_Prime_sans_ici As Double
Dim DernLigne As Long
Dim i As Integer
With Worksheets("Feuil1")
DernLigne = .Range("A" & .Rows.Count).End(xlUp).Row
Set Prime_SANS_ICI = .Range("S1:S" & DernLigne)
Set Somme_Montant_Total_Reglement = .Range("I1:I" & DernLigne)
End With
For i = 2 To DernLigne
'Sinistre_Sur_Prime_SANS_ICI = Somme_Montant_Total_Reglement / Prime_SANS_ICI
Cells(i, 16).Value = Cells(i, 9).Value / Cells(i, 19).Value
Next i
End Sub
Sub Generation2()
Dim DernLigne As Long
Dim i As Integer
With Sheets("Sinistre_Historique_ICIMM102_30")
DernLigne = .Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To DernLigne
' date souscription + durée de garantie > date de survenance
If .Cells(i, 7) + .Cells(i, 16) > .Cells(i, 21) Then
Sheets("Feuil1").Cells(i, 17).Value = "oui"
Else
Sheets("Feuil1").Cells(i, 17).Value = "non"
End If
Next i
End With
End Sub
merci beaucoup pour ton aide
bonjour,
voici un macro qui ouvre les fichiers txt d'un répertoire donné et qui les copies sur une feuille dans le fichier contenant la macro.
Sub aargh()
Path = "repertoire des fichiers txt terminé par un /"
Set twb = ThisWorkbook
fn = Dir(Path & "*.txt")
While fn <> ""
Workbooks.OpenText Filename:= _
Path & fn, Origin:=xlWindows _
, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False
Set wbtxt = ActiveWorkbook
wbtxt.Sheets(1).Copy after:=twb.Worksheets(Worksheets.Count)
wbtxt.Close
fn = Dir()
Wend
End Sub
alors la mercii bcp mais pourrais tu m'expliquer comment tu as fais je comprend pas trop le code
sa marche mais y a un petit pb tout vient en txt mais le fichier est incompréhensible parce que moi quand je le convertis en excel je fais pour séparateur point virgule et tabulation
aude21 a écrit :sa marche mais y a un petit pb tout vient en txt mais le fichier est incompréhensible parce que moi quand je le convertis en excel je fais pour séparateur point virgule et tabulation
re bonjour,
tu mets semicolon:=true
dans l'instruction opentext
c'est ceux que j'ai fait mais je cmprend pas pq il me prend tt en decaler
rien est a leur place
comment je pourrais faire en sorte qu'il accepte les virgules
accent pardon
comment je pourrais faire aussi que sil ya des date qui saffiche sa s'affiche au format jj/mm/aa parce que la sa s'affiche en mm/jj/aa
re-bonjour,
peux-tu faire un effort pour écrire correctement et respecter la charte du forum s'il-te-plaît ?
peux-tu mettre un exemple de fichier TXT "qui se lit mal" ? je n'ai pas de problème avec le fichier que tu as posté sur le forum.
re-bonjour
j'ai trouver mon erreur pour le format de la date j'ai utiliser FieldInfo et j'ai donné la valeurs 4 pour la colonne correspondant à une date
cependant je ne vois pas comment faire pour qu'il accepte les accents
merci de votre aide
désolé je me suis trompé de fichier
ce fichier n'est pas différent de celui que tu as mis précédemment.
c'est le deuxième j'ai rajouté une colonne ou il y a des mots avec accents par exemple pour Critere_Tarifaire_2
aude21 a écrit :c'est le deuxième j'ai rajouté une colonne ou il y a des mots avec accents par exemple pour Critere_Tarifaire_2
pas de problème pour lire les accents quand il y en a
pas d'accent sur critere_tarifaire dans le fichier txt.
sur la colonne du critaire tarifaire
Ta pas de problemes d'accent? moi il menvoie les mots mais a la place du é j'ai ã
bonsoir,
essaie avec le paramètre suivant dans opentext
Origin:=65001,
Bonjour,
Merci beaucoup h2so4 ça marche très bien