Re : Copier et Ranger ligne vers Tableau Excel à Partir userform
Private Sub CommandButton1_Click()
Workbooks.Open Filename:="V:\Maintenance\Gestion du Parc Matériel Valognes.xls"
Sheets("Parc Matériel").Activate
If ComboBox1 = "" Then
MsgBox ("Sélectionner une Section Matériel")
Exit Sub
Else
SectionMateriel = ComboBox1
End If
If TextBox1 = "" Then
MsgBox ("Saisir un Numéro de Machine")
Exit Sub
Else
NuméroMateriel = TextBox1
End If
If TextBox2 = "" Then
MsgBox ("Saisir un Nom de Matériel")
Exit Sub
Else
Matériel = TextBox2
End If
If ComboBox2 = "" Then
MsgBox ("Sélectionner une Implantation")
Exit Sub
Else
Implantation = ComboBox2
End If
If TextBox8 = "" Then
MsgBox ("Saisir une CMU en (T)")
Exit Sub
Else
CMU = TextBox8
End If
If TextBox3 = "" Then
MsgBox ("Saisir une Date de Mise en Service")
Exit Sub
Else
DateDeMiseEnService = TextBox3
End If
If TextBox7 = "" Then
DateDeControle = "NC"
Else
DateDeControle = TextBox7
End If
If ComboBox3 = "" Then
ArmoireElectrique = "NC"
Else
ArmoireElectrique = ComboBox3
End If
If TextBox4 = "" Then
N°DépartElectrique = "0"
Else
N°DépartElectrique = TextBox4
End If
If TextBox5 = "" Then
PuissanceElectrique = 0
Else
PuissanceElectrique = TextBox5
End If
If TextBox6 = "" Then
Diver = " "
Else
Diver = TextBox6
End If
If OptionButton1.Value = True Then
CE = "OUI"
Else
CE = "NON"
End If
If OptionButton3.Value = True Then
Adequation = "OUI"
Else
Adequation = "NON"
End If
Ligne = Range("A65536").End(xlUp).Row 'Vérification présence machine dans le tableau
Ligne = Ligne + 1 'vers lequel la ligne est copiée
NbCar = Len(NuméroMateriel) - 1
If Right(TextBox1, 1) = 0 Then
NuméroMateriel = NuméroMateriel * 100
For i = 3 To Ligne
If Cells(i, 2) = NuméroMateriel Then
MsgBox ("Ce matériel est déjà présent dans le parc. Vérifier le Numéro Machine")
Exit Sub
End If
Next i
NuméroMateriel = TextBox1
Else
End If
Sheets("Périodicité Inspection").Activate
For i = 1 To 20
If Cells(i, 1) = SectionMateriel Then
P = i
End If
Next
Sheets("Parc Matériel").Activate
Cells(Ligne, 1) = SectionMateriel
Cells(Ligne, 2) = NuméroMateriel
Cells(Ligne, 2).Select
If NbCar = 2 Then
Selection.NumberFormat = "0.0"
End If
If NbCar = 3 Then
Selection.NumberFormat = "0.00"
End If
Cells(Ligne, 3) = Matériel
Cells(Ligne, 4) = Implantation
Cells(Ligne, 5) = CMU
Cells(Ligne, 6) = DateDeMiseEnService
Cells(Ligne, 7) = DateDeControle
Cells(Ligne, 8) = "=date(YEAR(G" & Ligne & "),MONTH(G" & Ligne & ")+('Périodicité Inspection'!B" & P & "),DAY(G" & Ligne & "))"
Cells(Ligne, 9) = CE
Cells(Ligne, 10) = Adequation
Cells(Ligne, 11) = ArmoireElectrique
Cells(Ligne, 12) = N°DépartElectrique
Cells(Ligne, 13) = PuissanceElectrique
Cells(Ligne, 14) = Diver
Range(Cells(Ligne, 1), Cells(Ligne, 14)).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(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells(Ligne, 1).Select
With Selection.Interior
.ColorIndex = 15
.Pattern = xlSolid
End With
Range("A2:N300").Sort Key1:=Range("B3"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
ActiveWorkbook.Save
ActiveWorkbook.Close
Sheets("Tableau de Bord Saint Sauveur").Activate 'Revient à l'interface de départ
Unload Me
End Sub