1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29
| Private Sub BT_Calcul_pose_grutage_Click()
Dim Classeur_Cible As Workbook
Dim Feuille_Cible As Worksheet
Dim Tableau As ListObject
Dim Offre As Variant
Dim Cmde As Variant
Application.ScreenUpdating = False
If MsgBox("Ouvrir le fichier ?", vbYesNo + vbQuestion, "Copie Calcul déplacement pose grutage") = vbYes Then
Unload Me
If ThisWorkbook.ReadOnly = False Then 'Supprimer des actions si le fichier est en lecture seule
ThisWorkbook.Save
End If
Offre = Sheets("Suivi").Cells(ActiveCell.Row, Sheets("Suivi").ListObjects("TS_Suivi").ListColumns("Ext").Index).value
Cmde = Sheets("Suivi").Cells(ActiveCell.Row, Sheets("Suivi").ListObjects("TS_Suivi").ListColumns("Cmde").Index).value
Set Classeur_Cible = Workbooks.Open("A:\Secteur Architectes\24 - Data\Copie Calcul déplacement pose grutage.xlsm", ReadOnly:=True)
'Ouvrir userform du fichier cible Search_Offre.Show qui est dans la macro Ouvrir_Search_Offre_pour_fichier_fca
'Il y a 2 macros dans le fichier cible por que le code fonctionne
Application.Run "'" & "Copie Calcul déplacement pose grutage.xlsm" & "'!SetOffreValue", Offre
Application.Run "'" & "Copie Calcul déplacement pose grutage.xlsm" & "'!Boutons_Fonctions.Ouvrir_Search_Offre_pour_fichier_fca"
Classeur_Cible.Sheets("Calcul").Range("Cell_Cmde") = Cmde
Set Tableau = Nothing
Set Classeur_Cible = Nothing
Set Feuille_Cible = Nothing
End If
Application.ScreenUpdating = True
End Sub |
Partager