Sub Insertcolonne()
Dim Cellule_en_cours As Range
Dim Cellule As String
Dim Celluledecal As String
Dim Nom_projet As String
Dim Nom_client As String
Dim Projet As String
Dim reponse As Variant
Set Cellule_en_cours = ActiveCell
If Cellule_en_cours.Row > 1 Then
Call MsgBox("La cellule active doit être sur la ligne 1", vbCritical Or vbDefaultButton1, Application.Name)
Exit Sub
End If
'
Do
'expression.InputBox(Prompt, Title, Default, Left, Top, HelpFile, HelpContextId, Type)
Do
reponse = Application.InputBox(Prompt:="Nom du client?", Type:=2, Default:="", Title:="Donnée de base")
Select Case reponse
Case ""
MsgBox "vous n'avez pas fait de saisies!" & Chr(13) & "recommencez!", vbCritical, ""
Case False
Exit Sub
Case Else
Exit Do
End Select
Loop
Nom_client = UCase(Mid(reponse, 1, 1)) & LCase(Mid(reponse, 2, 254))
Do
reponse = Application.InputBox(Prompt:="Nom du projet ou lieu ?", Type:=2, Default:="")
Select Case reponse
Case ""
MsgBox "vous n'avez pas fait de saisies!" & Chr(13) & "recommencez!", vbCritical, ""
Case False
Exit Sub
Case Else
Exit Do
End Select
Loop
Nom_projet = UCase(Mid(reponse, 1, 1)) & LCase(Mid(reponse, 2, 254))
Projet = Nom_client + " - " + Nom_projet
Select Case MsgBox("Nom du client :" & Nom_client _
& vbCrLf & "Nom du projet ou lieu :" & Nom_projet _
& vbCrLf & "" _
& vbCrLf & "Etes vous d'accord ?" _
, vbYesNoCancel Or vbInformation Or vbDefaultButton1, "Confirmation saisie")
Case vbYes
Exit Do
Case vbCancel
Exit Sub
Case vbNo
End Select
Loop
Columns("A:B").Select
Selection.Copy
Cellule_en_cours.Select
Selection.Insert Shift:=xlToRight
Cellule_en_cours.Select
Cellule = Mid(ActiveCell.Address, 2, InStr(2, ActiveCell.Address, "$") - 2)
Celluledecal = Cellule + "1"
Range(Celluledecal).Value = Projet
End Sub