Re : modification code macro pour fonctionnement sur xls 2003
Voici la macro en question avec les 2 lignes en rouges posant problémes selon le déroulement de cette macro (suivant mes choix)
Sub Liaisons()
Dim WsB As Worksheet 'WsB est une feuille
Dim WsM As Worksheet 'WsM est une feuille
Dim Sh As Shape 'Sh est une case à cocher
Dim RepB As Range 'RepB est une réponse
Dim RepL As Range 'RepL est une réponse
Dim RepM As Range
Set WsB = Sheets("base de donnée reservation") 'WsB = feuille base de donnée reservation
Set WsM = Sheets("MBC") 'WsM = feuille MBC
On Error Resume Next 'enlève la gestion des erreurs pour le reste du programme,
Set RepB = Nothing 'Sans ça on ne peut pas quitter l'InputBox avec annuler ou croix de fermeturesert à quitter l'InputBox avec annuler ou croix de fermeture
Set RepL = Nothing
Set RepM = Nothing
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'demande de la ligne du tableau de reservation à lier
Set RepB = Application.InputBox("Ligne du matériel à lier", Type:=8)
If RepB Is Nothing Then Exit Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' demande de liaison avec un descriptif oui ou non
If MsgBox("Voulez vous lier à un descriptif?", vbYesNo, "Demande de confirmation") = vbYes Then
'demande d'association du descriptif correspondant
Set RepL = Application.InputBox(" Ligne du descriptif correspondant", Type:=8)
If RepB Is Nothing Then Exit Sub
'Recherche du Checkbox dans la colonne B
For Each Sh In WsB.Shapes
If Sh.TopLeftCell.Address = Range("B" & RepB.Row).Address Then
Exit For
End If
Next Sh
If Sh Is Nothing Then
MsgBox "Pas de case à cocher dans la cellule " & Range("B" & RepB.Row).Address
Exit Sub
End If
'automatisation du lien de controle de la case MAQF à cocher
Sh.ControlFormat.LinkedCell = "'" & RepL.Parent.Name & "'!" & Range("A" & RepL.Row).Address
WsB.Range("AI" & RepB.Row).Formula = "='" & RepL.Parent.Name & "'!" & Range("A" & RepL.Row).Address
'REPERE :la colonne I de la même ligne du descriptif = la colonne D de la même ligne du listing reservation
Sheets(RepL.Parent.Name).Range("I" & RepL.Row).Formula = "='" & RepB.Parent.Name & "'!" & Range("D" & RepB.Row).Address
'DESIGNATION :la colonne B de la même ligne du descriptif = la colonne E de la même ligne du listing reservation
Sheets(RepL.Parent.Name).Range("B" & RepL.Row).Formula = "='" & RepB.Parent.Name & "'!" & Range("E" & RepB.Row).Address
'QUANTITE :la colonne E de la même ligne du descriptif = la colonne Y de la même ligne du listing reservation
Sheets(RepL.Parent.Name).Range("E" & RepL.Row).Formula = "='" & RepB.Parent.Name & "'!" & Range("Y" & RepB.Row).Address
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
WsB.Select
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'demande de liaison avec une ligne MBC oui ou non
If MsgBox("Voulez vous lier à un MBC?", vbYesNo, "Demande de confirmation") = vbYes Then
WsM.Select
'demande de création d'une ligne vierge dans MBC oui ou non
If MsgBox("Voulez vous creer une ligne vierge à lier ?", vbYesNo, "Demande de confirmation") = vbYes Then
Application.Run "nouveau_MABC"
MsgBox "une nouvelle ligne a été crée"
End If
'demande d'association de la ligne correspondante
Set RepM = Application.InputBox(" Ligne du MBC correspondant", Type:=8)
If RepM Is Nothing Then Exit Sub
'Recherche du Checkbox dans la colonne C
For Each Sh In WsB.Shapes
If Sh.TopLeftCell.Address = Range("C" & RepB.Row).Address Then
Exit For
End If
Next Sh
If Sh Is Nothing Then
MsgBox "Pas de case à cocher dans la cellule " & Range("C" & RepB.Row).Address
Exit Sub
End If
'automatisation du lien de controle de la case MABC à cocher
Sh.ControlFormat.LinkedCell = "'" & RepM.Parent.Name & "'!" & Range("A" & RepM.Row).Address
WsB.Range("AJ" & RepB.Row).Formula = "='" & RepM.Parent.Name & "'!" & Range("A" & RepM.Row).Address
'DESIGNATION :la colonne B de la même ligne du MABC = la colonne E de la même ligne du listing reservation
Sheets(RepM.Parent.Name).Range("B" & RepM.Row).Formula = "='" & RepB.Parent.Name & "'!" & Range("E" & RepB.Row).Address
'QUANTITE :la colonne C de la même ligne du MABC = la colonne Y de la même ligne du listing reservation
Sheets(RepM.Parent.Name).Range("C" & RepM.Row).Formula = "='" & RepB.Parent.Name & "'!" & Range("Y" & RepB.Row).Address
'REPERE :la colonne D de la même ligne du MABC = la colonne D de la même ligne du listing reservation
Sheets(RepM.Parent.Name).Range("D" & RepM.Row).Formula = "='" & RepB.Parent.Name & "'!" & Range("D" & RepB.Row).Address
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
WsB.Select
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error GoTo 0 ' Restaure la gestion des erreurs
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub
