Re bonjour, je viens vers vous pour savoir si mon code est simplifiable et je voudrais savoir comment le rendre plus simple pour pouvoir le faire par la suite.
je vous mets le code:
Cordialement
je vous mets le code:
Code:
Option Explicit
Public Continuer As Boolean
Public Symptome As Boolean
Public Section As Boolean
Public Mdate As Boolean
Public FichierAOuvrir As Variant
Public Wb As Workbook
Public MonFichier As String
Public MonRepertoire As String
Sub OuvrirFichierExcelALOuverture()
Continuer = False
With UserForm2
.Show
End With
If Continuer = False Then Exit Sub
OuvertureFichiers MonRepertoire, MonFichier
End Sub
Sub OuvertureFichiers(RepertoireFichier, NomFichier)
If Continuer = True And Symptome = True Then
For Each Wb In Workbooks
Select Case Wb.Name
Case NomFichier
Wb.Activate
Continuer = False
Exit For
End Select
Next Wb
If Continuer = True Then Workbooks.Open Filename:=RepertoireFichier & "\" & NomFichier
Workbooks(NomFichier).Sheets(1).Copy Before:=Workbooks("essai.xlsm").Sheets(1)
Sheets(1).Activate
Cells.Style = "Normal"
Columns("J:J").Insert Shift:=xlToRight
Call formule
Worksheets("Sheet1").Name = "Feuil1"
Workbooks(NomFichier).Close False
Call Convertion
Call nombre
Sheets("ISY").Activate
ActiveSheet.Unprotect ""
Sheets("Feuil1").Range("Q3:Q1000" & _
Range("A65535").End(xlUp).Row).Name = "ISY"
Sheets("Feuil1").Range("J3:J1000" & _
Range("A65535").End(xlUp).Row).Name = "Difference"
Sheets("Feuil1").Range("F3:F1000" & _
Range("A65535").End(xlUp).Row).Name = "Date"
Sheets("Feuil1").Range("M3").Name = "Nom"
Sheets("Feuil1").Range("Q1:Q1000").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("A3"), Unique:=True
Sheets("ISY").Range("A4:A45").Select
Call MEF
Call graph
Sheets("ISY").Activate
ActiveSheet.Protect ""
End If
If Continuer = True And Mdate = True Then
For Each Wb In Workbooks
Select Case Wb.Name
Case NomFichier
Wb.Activate
Continuer = False
Exit For
End Select
Next Wb
If Continuer = True Then Workbooks.Open Filename:=RepertoireFichier & "\" & NomFichier
Workbooks(NomFichier).Sheets(1).Copy Before:=Workbooks("essai.xlsm").Sheets(1)
Sheets(1).Activate
Worksheets("Sheet1").Name = "Feuil1"
Workbooks(NomFichier).Close False
Sheets("GraphMdate").Activate
Sheets("Feuil1").Range("J3:J3000" & _
Range("A65535").End(xlUp).Row).Name = "difference"
Sheets("Feuil1").Range("J3:J3000").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("A2"), Unique:=True
Range("A2:A1000").Select
Selection.TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Call Trier
End If
End Sub
Sub formule()
Dim nbLigne As Integer, nbColonne As Integer, i As Integer
nbLigne = Cells.SpecialCells(xlCellTypeLastCell).Row
nbColonne = Range("J3").End(xlToLeft).Column
For i = 3 To nbLigne
If Not Range("H" & i).Value = "" Then Range("J" & i).Formula = "=(I" & i & "-h" & i & ")"
Next
End Sub
Sub Convertion()
Dim i As Integer
For i = 0 To 3
CONVERTIR Worksheets("Feuil1").Columns("H:H").Offset(, i)
Next i
End Sub
Private Sub CONVERTIR(ByVal Plage As Range)
Plage.TextToColumns Destination:=Plage.Cells(1, 1), DataType:=xlDelimited, FieldInfo:=Array(1, 5)
End Sub
Sub graph()
Sheets("GraphSy").Activate
Sheets("Feuil1").Range("Q1:Q1000").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("A1"), Unique:=True
End Sub
Sub nombre()
Range("F3:F1000").Select
Selection.TextToColumns Destination:=Range("F3"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
End Sub
Sub Trier()
ActiveWorkbook.Worksheets("GraphMdate").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("GraphMdate").Sort.SortFields.Add Key:=Range("A2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("GraphMdate").Sort
.SetRange Range("A2:A1000")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Sub MEF()
With ActiveCell
.Borders.Weight = xlThin
With .Font
.Bold = False
.Size = 8
.Italic = True
.Name = "Arial"
End With
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 9148836
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub
Cordialement