voila un chtit bou de code ...
Sub Enregistrement_litige()
'
' Enregistrement_litige Macro
' Macro enregistrée le 02/03/00 par Mbipbip'
If DialogSheets("Dialog1" ).Show Then
' AFFECTATIONS DES INFOS SAISIES A DES VARIABLES
Windows("Gestion litiges Indice C.xls" ).Activate
DateLitige = DialogSheets("dialog1" ).EditBoxes("modification 4" ).Text
NumLitigeClient = DialogSheets("dialog1" ).EditBoxes("modification 30" ).Text
Démérite = DialogSheets("dialog1" ).EditBoxes("modification 11" ).Text
NumLitigeTex = DialogSheets("dialog1" ).EditBoxes("modification 9" ).Text
RefTex = DialogSheets("dialog1" ).EditBoxes("modification 15" ).Text
RefClient = DialogSheets("dialog1" ).EditBoxes("modification 16" ).Text
NumBL = DialogSheets("dialog1" ).EditBoxes("modification 43" ).Text
LOT = DialogSheets("dialog1" ).EditBoxes("modification 60" ).Text
Galia = DialogSheets("dialog1" ).EditBoxes("modification 61" ).Text
DésignationPièce = DialogSheets("dialog1" ).EditBoxes("modification 42" ).Text
Commentaire = DialogSheets("dialog1" ).EditBoxes("modification 19" ).Text
Année = DialogSheets("dialog1" ).EditBoxes("modification 120" ).Text
Mois = DialogSheets("dialog1" ).EditBoxes("modification 130" ).Text
SiteTex = Sheets("Menus déroulants" ).Cells(DialogSheets("Dialog1" ).DropDowns("Zone combinée 57" ).Value, 14).Value
Secteur = Sheets("Menus déroulants" ).Cells(DialogSheets("Dialog1" ).DropDowns("Zone combinée 29" ).Value, 6).Value
Cdc = Sheets("Menus déroulants" ).Cells(DialogSheets("Dialog1" ).DropDowns("Zone combinée 51" ).Value, 8).Value
TypeClient = Sheets("Menus déroulants" ).Cells(DialogSheets("Dialog1" ).DropDowns("Zone combinée 59" ).Value, 16).Value
Client = Sheets("Menus déroulants" ).Cells(DialogSheets("Dialog1" ).DropDowns("Zone combinée 14" ).Value, 20).Value
SiteClient = Sheets("Menus déroulants" ).Cells(DialogSheets("Dialog1" ).DropDowns("Zone combinée 41" ).Value, 22).Value
NomClient = Sheets("Annuaire client" ).Cells(DialogSheets("Dialog1" ).DropDowns("Zone combinée 74" ).Value, 1).Value
Famille = Sheets("Menus déroulants" ).Cells(DialogSheets("Dialog1" ).DropDowns("Zone combinée 69" ).Value, 18).Value
NomTex = Sheets("Menus déroulants" ).Cells(DialogSheets("Dialog1" ).DropDowns("Zone combinée 7" ).Value, 10).Value
Nature = Sheets("Menus déroulants" ).Cells(DialogSheets("Dialog1" ).DropDowns("Zone combinée 49" ).Value, 4).Value
défaut = Sheets("Menus déroulants" ).Cells(DialogSheets("Dialog1" ).DropDowns("Zone combinée 18" ).Value, 2).Value
' COPIE ET SAUVEGARDE DES INFOS SAISIES DANS LE LISTING
ChDrive "C"
ChDir ("C:\RECLAMATIONS CLIENTS\Listing\" )
Workbooks.Open FileName:=Année
Sheets("Listing" ).Select
Range("F1" ).Select
NbLigne = 0
While Selection.Value <> ""
NbLigne = NbLigne + 1
If ActiveCell.Value = NumLitigeTex Then
MsgBox ("CE NUMERO DE LITIGE INTERNE EXISTE DEJA !" )
ActiveWorkbook.Close
GoTo ligne500
End If
ActiveCell.Offset(1, 0).Select
Wend
Range("A1" ).Select
NbLigne = 0
While Selection.Value <> ""
NbLigne = NbLigne + 1
ActiveCell.Offset(1, 0).Select
Wend
Cells(NbLigne + 1, 1).Value = SiteTex
Cells(NbLigne + 1, 4).Value = DateLitige
Cells(NbLigne + 1, 7).Value = NumLitigeClient
Cells(NbLigne + 1, 5).Value = Démérite
Cells(NbLigne + 1, 6).Value = NumLitigeTex
Cells(NbLigne + 1, 8).Value = RefTex
Cells(NbLigne + 1, 9).Value = RefClient
Cells(NbLigne + 1, 37).Value = NumBL
Cells(NbLigne + 1, 38).Value = LOT
Cells(NbLigne + 1, 39).Value = Galia
Cells(NbLigne + 1, 35).Value = DésignationPièce
Cells(NbLigne + 1, 40).Value = Commentaire
Cells(NbLigne + 1, 1).Value = SiteTex
Cells(NbLigne + 1, 32).Value = Secteur
Cells(NbLigne + 1, 33).Value = Cdc
Cells(NbLigne + 1, 41).Value = TypeClient
Cells(NbLigne + 1, 2).Value = Client
Cells(NbLigne + 1, 3).Value = SiteClient
Cells(NbLigne + 1, 36).Value = NomClient
Cells(NbLigne + 1, 14).Value = Famille
Cells(NbLigne + 1, 42).Value = NomTex
Cells(NbLigne + 1, 34).Value = Nature
Cells(NbLigne + 1, 10).Value = défaut
Cells(NbLigne + 1, 51).Value = Mois
ActiveWorkbook.Save
ActiveWorkbook.Close
ChDrive "C"
ChDir ("C:\RECLAMATIONS CLIENTS\Actions ext\" )
Workbooks.Open FileName:="SUIVI AC RECL 2002.xls"
Sheets("Suivi actions" ).Select
Range("A11" ).Select
NbLigne = 10
While Selection.Value <> ""
NbLigne = NbLigne + 1
If ActiveCell.Value = NumLitigeTex Then
MsgBox ("CE NUMERO DE LITIGE INTERNE EXISTE DEJA !" )
ActiveWorkbook.Close
GoTo ligne500
End If
ActiveCell.Offset(1, 0).Select
Wend
Range("A11" ).Select
NbLigne = 10
While Selection.Value <> ""
NbLigne = NbLigne + 1
ActiveCell.Offset(1, 0).Select
Wend
Cells(NbLigne + 1, 3).Value = DateLitige
Cells(NbLigne + 1, 4).Value = NumLitigeClient
Cells(NbLigne + 1, 1).Value = NumLitigeTex
Cells(NbLigne + 1, 8).Value = RefTex
Cells(NbLigne + 1, 6).Value = RefClient
Cells(NbLigne + 1, 7).Value = DésignationPièce
Cells(NbLigne + 1, 5).Value = Client
Cells(NbLigne + 1, 9).Value = Commentaire
ActiveWorkbook.Save
ActiveWorkbook.Close
'AFFICHAGE BOITE DE DIALOGUE POUR CREATION AR
If DialogSheets("Dialog3" ).Show Then
'COPIE DES INFO DU LITIGES
Windows("Gestion litiges Indice C.xls" ).Activate
NumLitigeClient = DialogSheets("dialog1" ).EditBoxes("modification 30" ).Text
Démérite = DialogSheets("dialog1" ).EditBoxes("modification 11" ).Text
NumLitigeTex = DialogSheets("dialog1" ).EditBoxes("modification 9" ).Text
RefTex = DialogSheets("dialog1" ).EditBoxes("modification 15" ).Text
RefClient = DialogSheets("dialog1" ).EditBoxes("modification 16" ).Text
NumBL = DialogSheets("dialog1" ).EditBoxes("modification 43" ).Text
LOT = DialogSheets("dialog1" ).EditBoxes("modification 60" ).Text
Galia = DialogSheets("dialog1" ).EditBoxes("modification 61" ).Text
DésignationPièce = DialogSheets("dialog1" ).EditBoxes("modification 42" ).Text
SiteTex = Sheets("Menus déroulants" ).Cells(DialogSheets("Dialog1" ).DropDowns("Zone combinée 57" ).Value, 14).Value
Client = Sheets("Menus déroulants" ).Cells(DialogSheets("Dialog1" ).DropDowns("Zone combinée 14" ).Value, 20).Value
SiteClient = Sheets("Menus déroulants" ).Cells(DialogSheets("Dialog1" ).DropDowns("Zone combinée 41" ).Value, 22).Value
NomClient = Sheets("Annuaire client" ).Cells(DialogSheets("Dialog1" ).DropDowns("Zone combinée 74" ).Value, 1).Value
NomTex = Sheets("Menus déroulants" ).Cells(DialogSheets("Dialog1" ).DropDowns("Zone combinée 7" ).Value, 10).Value
défaut = Sheets("Menus déroulants" ).Cells(DialogSheets("Dialog1" ).DropDowns("Zone combinée 18" ).Value, 2).Value
' RECHERCHE DES COORDONNEES DU CLIENT DANS L'ANNUAIRE
Sheets("Annuaire Client" ).Activate
Range("A2" ).Select
n = 0
While ActiveCell.Value <> NomClient
'If ActiveCell.Value = NomClient Then
ActiveCell.Offset(1, 0).Select
n = n + 1
If n > 1000 Then
MsgBox ("NE TROUVE PAS LES COORDONNES DU CLIENT" )
GoTo ligne10
End If
Wend
ActiveCell.Offset(0, 2).Select
TelClient = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
faxclient = ActiveCell.Value
'End If
ligne10:
Sheets("Menus déroulants" ).Activate
Range("J2" ).Select
n = 0
While ActiveCell.Value <> NomTex
ActiveCell.Offset(1, 0).Select
n = n + 1
If n > 1000 Then
MsgBox ("NE TROUVE PAS LES COORDONNEES DU CORRESPONDANT bipbip!" )
GoTo ligne20
End If
Wend
ActiveCell.Offset(0, 1).Select
TelTex = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
faxTex = ActiveCell.Value
Sheets("Nouveau litige" ).Select
Range("A1" ).Select
ligne20:
'SAISIE INFORMATIONS LOT GARANTI CONFORME
Message = "Date d'expédition du lot garanti conforme"
titre = "INFORMATIONS PROCHAINE LIVRAISON GARANTIE CONFORME"
Déf = "à venir"
DateOK = InputBox(Message, titre, Déf)
Message = "N° du B.L."
titre = "INFORMATIONS PROCHAINE LIVRAISON GARANTIE CONFORME"
Déf = "à venir"
BLOK = InputBox(Message, titre, Déf)
Message = "N° du lot de fabrication"
titre = "INFORMATIONS PROCHAINE LIVRAISON GARANTIE CONFORME"
Déf = "à venir"
LotOK = InputBox(Message, titre, Déf)
' CREATION DE L'ACCUSE DE RECEPTION
ChDrive "C"
ChDir "C:\RECLAMATIONS CLIENTS\ACCUSE RECEPTION"
Workbooks.Open FileName:="Modèle AR.xls"
Sheets("AR" ).Select
Range("I20" ).Value = NumLitigeClient
Range("Y20" ).Value = Démérite
Range("V2" ).Value = NumLitigeTex
Range("W21" ).Value = RefTex
Range("F21" ).Value = RefClient
Range("M24" ).Value = NumBL
Range("D24" ).Value = LOT
Range("X24" ).Value = Galia
Range("G23" ).Value = DésignationPièce
Range("T1" ).Value = SiteTex
Range("E9" ).Value = Client
Range("Q9" ).Value = SiteClient
Range("M7" ).Value = NomClient
Range("K16" ).Value = NomTex
Range("AA7" ).Value = TelClient
Range("AA9" ).Value = faxclient
Range("AA16" ).Value = TelTex
Range("AA17" ).Value = faxTex
Range("K26" ).Value = défaut
Range("M48" ).Value = DateOK
Range("M49" ).Value = BLOK
Range("M50" ).Value = LotOK
DateAR = Range("AC1" ).Value
'COPIE DE LA DATE D'ACCUSE DE RECEPTION
ChDrive "C"
ChDir ("C:\RECLAMATIONS CLIENTS\Listing\" )
Workbooks.Open FileName:=Année
Sheets("Listing" ).Select
Range("A1" ).Select
NbLigne = 0
While Selection.Value <> ""
NbLigne = NbLigne + 1
ActiveCell.Offset(1, 0).Select
Wend
Cells(NbLigne, 43).Select
ActiveCell.Value = DateAR
Cells(NbLigne, 58).Value = DateOK
Cells(NbLigne, 59).Value = BLOK
Cells(NbLigne, 60).Value = LotOK
ActiveWorkbook.Save
ActiveWorkbook.Close
' SAUVEGARDE DE L'ACCUSE DE RECEPTION
Msg = "Souhaitez-vous conserver un enregistrement de l'accusé de réception ?"
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Définit les boutons.
Title = "ENREGISTRER ?"
Response1 = MsgBox(Msg, Style, Title)
If Response1 = vbYes Then ' L?utilisateur a choisit Yes.
Msg = "Enregistrer sous le fichier :"
Title = "SAUVEGARDE ACCUSE DE RECEPTION"
Response2 = InputBox(Msg, Title)
ChDrive "C"
ChDir ("C:\RECLAMATIONS CLIENTS\ACCUSE RECEPTION\" )
ActiveWorkbook.SaveAs FileName:=Response2
End If
If Response1 = vbNo Then
' ActiveWorkbook.Close
End If
End If
ligne500:
'Sheets("Nouveau litige" ).Select
'Range("A1" ).Select
End If
'End If
End Sub