Sub cas_concrait()
'
' import Macro
' Macro enregistrée le 19/10/2004 par Assniok
'
On Error GoTo gest_error
Dim date_svg, choix_utilisateur, nom_fichier As String
Workbooks.OpenText Filename:="R:\Users\lecrot\excel\BASE DE DONNEES.txt", Origin _
:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1)), _
TrailingMinusNumbers:=True
Rows("1:2").Select
Selection.Insert Shift:=xlDown
Range("F1").Select
ActiveCell.FormulaR1C1 = "=SUM(R[3]C:R[1599]C)"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Total heures"
Range("E2").Select
choix_utilisateur = MsgBox("Voulez vous formatter" & Chr(13) & Chr(13) & "votre tableau ?", vbYesNo, "Assniok 2004")
If choix_utilisateur = vbYes Then
Application.ScreenUpdating = False
Call formattage
Application.ScreenUpdating = True
End If
nom_fichier = InputBox("Nom du nouveau fichier ?", "Info Fichier", "liste client")
date_svg = Day(Date) & "-" & Month(Date) & "-" & Year(Date) & " " & Hour(Time) & "-" & Minute(Time) & "-" & Second(Time)
ActiveWorkbook.SaveAs Filename:="R:\Users\lecrot\excel\" & nom_fichier & " " & date_svg & ".xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Exit Sub
gest_error: MsgBox " L'application a rencontrée une erreur !! "
End Sub
Sub formattage()
'
' formattage Macro
' Macro enregistrée le 19/10/2004 par Assniok
'
'
Range("D3").Select
Selection.CurrentRegion.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Font.Bold = True
ActiveCell.Select
End Sub