Merci pour l'adresse du forum Office Vba qui me sera très utile.
Sans vouloir titiller et avoir le dernier mot, pour moi, le locked de combo box , c'était utile que sur une feuille protégée.
Je vous mets le code en question, un pe long pour le forum désolé
Sub CréationFichierSUivi()
'
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim nost As Long
'
nost = Cells(35, 5)
Nature = Cells(37, 5)
libelle = Cells(36, 9)
Depositaire = Cells(38, 5)
Isin1 = Cells(36, 5)
'Vérification que les taches aient bien été effectuées
If Depositaire = "PROCAPITAL" Then
If Sheets(1).CheckBox1 <> True Then
MsgBox "Verifiez que toutes les actions préalables aient bien été effectuées"
Exit Sub
End If
If Sheets(1).CheckBox3 <> True Then
MsgBox "Verifiez que toutes les actions préalables aient bien été effectuées"
Exit Sub
End If
If Sheets(1).CheckBox5 <> True Then
MsgBox "Verifiez que toutes les actions préalables aient bien été effectuées"
Exit Sub
End If
End If
If Depositaire = "GESTITRES" Then
If Sheets(1).CheckBox2 <> True Then
MsgBox "Verifiez que toutes les actions préalables aient bien été effectuées"
Exit Sub
End If
If Sheets(1).CheckBox4 <> True Then
MsgBox "Verifiez que toutes les actions préalables aient bien été effectuées"
Exit Sub
End If
If Sheets(1).CheckBox11 <> True Then
MsgBox "Verifiez que toutes les actions préalables aient bien été effectuées"
Exit Sub
End If
If Sheets(1).CheckBox5 <> True Then
MsgBox "Verifiez que toutes les actions préalables aient bien été effectuées"
Exit Sub
End If
End If
'Cochage de la checkbox
Sheets(1).CheckBox13 = True
'Récupération des donbnées du formulaire
reponse = MsgBox("Confirmez-vous la création du fichier de suivi de l'OST n°" & nost & " pour " & Depositaire & "?", vbYesNo)
If reponse = 7 Then
Exit Sub
End If
nost = Cells(35, 5)
Isin1 = Cells(36, 5)
Nature = Cells(37, 5)
Depositaire = Cells(38, 5)
Place = Cells(39, 5)
Parite = Cells(40, 5)
Commentaires = Cells(41, 5)
libelle = Cells(36, 9)
DateReception = Cells(37, 10)
DateDebut = Cells(38, 10)
DateEcheance = Cells(39, 10)
l = Cells(32, 14)
enregfich1 = Sheets(1).CheckBox1
feuilGest = Sheets(1).CheckBox2
CopieLignGest = Sheets(1).CheckBox4
CopieTxtGest = Sheets(1).CheckBox3
EnregReq1 = Sheets(1).CheckBox5
modifReq2 = Sheets(1).CheckBox7
EnregReq2 = Sheets(1).CheckBox6
MajMouv = Sheets(1).CheckBox8
EnvoiTabPC = Sheets(1).CheckBox9
EnvoiTabInit = Sheets(1).CheckBox10
EnvoiTabRel = Sheets(1).CheckBox12
creatfich = Sheets(1).CheckBox13
creatges = Sheets(1).CheckBox11
'ouverture du fichier de PRocap de l'OST
Workbooks.OpenText Filename:= _
"H:\Back Clientele\OST\Suivi OST\OST\" & nost & "******************"
FichierOst = ActiveWorkbook.Name
Sheets(1).Select
nblignesC1 = ActiveSheet.UsedRange.Rows.Count
If Cells(1, 1) = "" Then
NbLignesProCap = 0
Else
NbLignesProCap = nblignesC1
End If
nblignesC = ActiveSheet.UsedRange.Rows.Count
Columns("E:I").Select
Selection.Insert shift:=xlToRight
Range("E2").Select
'rappatriement des infos de gestitres
If Depositaire = "GESTITRES" Then
Sheets(2).Select
nblignesGes = ActiveSheet.UsedRange.Rows.Count
Range("B1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets(1).Select
Range("C1").Select
ActiveSheet.Paste
Sheets(2).Select
Range("E1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets(1).Select
Range("K1").Select
ActiveSheet.Paste
Rows(nblignesC1).Select
Selection.Insert shift:=xlDown
End If
'ouverture de la requête
ChDir "H:\Back Clientele\OST\Suivi OST\OST"
Workbooks.Open Filename:="H:\Back Clientele\OST\Suivi OST\OST\Requêtes" & nost & "1.csv"
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, 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))
Columns("E:E").Select
Selection.Cut
Columns("A:A").Select
Selection.Insert shift:=xlToRight
Columns("E:E").Select
Selection.Delete shift:=xlToLeft
Windows(FichierOst).Activate
Sheets(1).Select
nblignesC = ActiveSheet.UsedRange.Rows.Count
Range("E2").Select
'Récupération des infos de la requête conservateur
Sheets(1).Select
nblignesC = Cells(2, 3).End(xlDown).Row()
Range("E2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],Requêtes" & nost & "1.csv!R2C1:R50000C5,2,0)"
If nblignesC > 2 Then
Selection.AutoFill Destination:=Range("E2:E" & nblignesC)
End If
Range("E2:E13").Select
Range("F2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],Requêtes" & nost & "1.csv!R2C1:R50000C3,3,0)"
If nblignesC > 2 Then
Selection.AutoFill Destination:=Range("F2:F" & nblignesC)
End If
Range("E1").Select
ActiveCell.FormulaR1C1 = "Code Porteur"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Libellé"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Type de compte"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Dépositaire"
Range("K1").Select
ActiveCell.FormulaR1C1 = "Quantité détenue"
Range("G2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC3,Requêtes" & nost & "1.csv!R2C1:R50000C6,4,0)"
Range("G2").Select
If nblignesC > 2 Then
Selection.AutoFill Destination:=Range("G2:G" & nblignesC)
End If
Selection.AutoFill Destination:=Range("G2:H2"), Type:=xlFillDefault
Range("H2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC3,Requêtes" & nost & "1.csv!R2C1:R50000C6,5,0)"
Range("H2").Select
If nblignesC > 2 Then
Selection.AutoFill Destination:=Range("H2:H" & nblignesC)
End If
Range("H2:H13").Select
Columns("I:I").Select
Selection.Delete shift:=xlToLeft
For i = 2 To nblignesC
If Cells(i, 7) = 0 Then
Cells(i, 7) = "Autre"
End If
If Cells(i, 7) = 1 Then
Cells(i, 7) = "Ordinaire"
End If
If Cells(i, 7) = 2 Then
Cells(i, 7) = "PEA"
End If
Next i
'Mise en page du tableau
Range("E2:H" & nblignesC).Select
Selection.Copy
Range("E2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Isin = Cells(2, 1)
Rows("1:1").Select
Selection.Insert shift:=xlDown
Rows("1:1").Select
Selection.Insert shift:=xlDown
nblignesC = nblignesC + 2
Range("C1").Select
ActiveCell.FormulaR1C1 = Nature & " de " & libelle & " " & Isin
Columns("A:B").EntireColumn.Hidden = True
Range("C1:M1").Select
With Selection
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
End With
With Selection.Font
.FontStyle = "Gras"
.Size = 14
.ColorIndex = 9
End With
Columns("F:F").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("D:D").EntireColumn.Hidden = True
Columns("I:I").EntireColumn.Hidden = True
ActiveWindow.DisplayGridlines = False
Range("C1").Select
'mise en page si gestitres
If Depositaire = "GESTITRES" Then
Rows("3:3").Select
Range("C3").Activate
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Rows("3:3").Select
Range("C3").Activate
Selection.Font.Bold = True
Columns("J:J").Select
Selection.Copy
Range("K1").Select
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("K16").Select
Application.CutCopyMode = False
Range("K3").Select
ActiveCell.FormulaR1C1 = "Réponse"
With ActiveCell.Characters(Start:=1, Length:=7).Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("C3:K" & nblignesC).Select
Range("K3").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
ActiveWorkbook.Save
'Ouverture de Racap OST'
ChDir "H:\Back Clientele\OST ARCHIVE"
Workbooks.Open Filename:="H:\Back Clientele\OST ARCHIVE\OST RECAP.xls"
Sheets(2).Select
nblignes = ActiveSheet.UsedRange.Rows.Count + 1
j = 0
For i = 4 To nblignes + 2
If Cells(i, 1) = nost Then
d = i
Cells(d, 1) = nost
Cells(d, 2) = Depositaire
Cells(d, 3) = Place
Cells(d, 4) = Isin1
Cells(d, 5) = libelle
Cells(d, 6) = Nature
Cells(d, 7) = DateReception
Cells(d, 8) = DateEcheance
Cells(d, 9) = Parite
Cells(d, 10) = Commentaires
Cells(d, 12) = DateDebut
Cells(d, 13) = enregfich1
Cells(d, 14) = feuilGest
Cells(d, 15) = CopieLignGest
Cells(d, 16) = CopieTxtGest
Cells(d, 17) = EnregReq1
Cells(d, 18) = modifReq2
Cells(d, 19) = EnregReq2
Cells(d, 20) = MajMouv
Cells(d, 21) = EnvoiTabPC
Cells(d, 22) = EnvoiTabInit
Cells(d, 23) = EnvoiTabRel
Cells(d, 24) = creatfich
Cells(d, 25) = creatges
Cells(d, 26) = NbLignesProCap
Cells(d, 27) = nblignesGes
i = nblignes
j = 1
End If
Next i
ActiveWorkbook.Close True
Windows("Suivi OST.xls").Activate
End Sub