E
Eric
Guest
1°) COMMENT LIEE CES 2 MACROS POUR QUELLE NE FASSE PLUS QU'UNE, QUE JE PUISSE AFFECTER A UN BOUTON.
2°) D'AUTRE PART DS UNE LISTE EST T'IL POSSIBLE DE TRIER LES DONNEES CONTENUES S CELLE-CI EN UTILISANT DES FOURCHETTES (COMPRIS ENTRE)
MERCI D'AVANCE POUR VOTRE AIDE.
MACRO(1)
Option Explicit
Const MandatN° = "B3"
Const Prix = "I2"
Const TypeAff = "B7"
Const Secteur = "I7"
Const CP = "C13"
Const Ville = "G13"
Const NbChbre = "H25"
Const Salon = "D33"
Const Sejour = "D32"
Const Terrain = "B60"
Const Garage = "D52"
Const Nom = "B9"
Const Prenom = "H9"
Const NbChamps = 13
Const Masque = "MASQUE SAISIE"
'Le nom du fichier Base
Const FBase = "base.xls"
'le nom de la feuille du fichier Base où copier les données
Const Base = "BASE"
--------------------------------------------------------------------------------------------
Function LastLigne(NomFichier, NomFeuille)
LastLigne = Workbooks(NomFichier).Worksheets(NomFeuille).Range("A65534"). _
End(xlUp).Offset(1, 0).Row
End Function
-------------------------------------------------------------------------------------------
Private Function Is_Ouvert(P_Fichier) As Variant
Is_Ouvert = False
On Error Resume Next
Is_Ouvert = Workbooks(P_Fichier).Name
End Function
-------------------------------------------------------------------------------------------
Sub Valide_Saisie()
Dim Ligne As String
Dim Champs, Boucle As Byte
Dim ValBase
Dim ValMasque
Champs = Array(MandatN°, Prix, TypeAff, Secteur, CP, Ville, NbChbre, Salon, Sejour, Terrain, Garage, Nom, Prenom)
If Is_Ouvert(FBase) = False Then Workbooks.Open FBase
Set ValMasque = ThisWorkbook.Worksheets(Masque)
Set ValBase = Workbooks(FBase).Worksheets(Base)
Ligne = LastLigne(FBase, Base)
For Boucle = LBound(Champs) To UBound(Champs)
'With Worksheets(Masque).Range(Champs(Boucle))
With ValMasque.Range(Champs(Boucle))
ValBase.Cells(Ligne, Boucle + 1).Value = .Value
End With
Next Boucle
End Sub
----------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------
MACRO(2)
Sub Enr_Fin()
ChDir "C:\Affiches"
nomrepertoire = CurDir & "\" & Range("B3").Value
If Dir(nomrepertoire, vbDirectory) <> "" Then MsgBox "Répertoire Existant, Validez par OK" Else MkDir nomrepertoire
nomsauvegarde = nomrepertoire & "\" & Range("B3").Value
ActiveWorkbook.SaveAs Filename:=nomsauvegarde, FileFormat _
:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
ChDir "C:\Eric\Mandats"
ActiveWorkbook.SaveAs Filename:=Range("B3").Value, FileFormat _
:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
MsgBox "Votre fiche est enregistrée. MERCI."
End Sub
2°) D'AUTRE PART DS UNE LISTE EST T'IL POSSIBLE DE TRIER LES DONNEES CONTENUES S CELLE-CI EN UTILISANT DES FOURCHETTES (COMPRIS ENTRE)
MERCI D'AVANCE POUR VOTRE AIDE.
MACRO(1)
Option Explicit
Const MandatN° = "B3"
Const Prix = "I2"
Const TypeAff = "B7"
Const Secteur = "I7"
Const CP = "C13"
Const Ville = "G13"
Const NbChbre = "H25"
Const Salon = "D33"
Const Sejour = "D32"
Const Terrain = "B60"
Const Garage = "D52"
Const Nom = "B9"
Const Prenom = "H9"
Const NbChamps = 13
Const Masque = "MASQUE SAISIE"
'Le nom du fichier Base
Const FBase = "base.xls"
'le nom de la feuille du fichier Base où copier les données
Const Base = "BASE"
--------------------------------------------------------------------------------------------
Function LastLigne(NomFichier, NomFeuille)
LastLigne = Workbooks(NomFichier).Worksheets(NomFeuille).Range("A65534"). _
End(xlUp).Offset(1, 0).Row
End Function
-------------------------------------------------------------------------------------------
Private Function Is_Ouvert(P_Fichier) As Variant
Is_Ouvert = False
On Error Resume Next
Is_Ouvert = Workbooks(P_Fichier).Name
End Function
-------------------------------------------------------------------------------------------
Sub Valide_Saisie()
Dim Ligne As String
Dim Champs, Boucle As Byte
Dim ValBase
Dim ValMasque
Champs = Array(MandatN°, Prix, TypeAff, Secteur, CP, Ville, NbChbre, Salon, Sejour, Terrain, Garage, Nom, Prenom)
If Is_Ouvert(FBase) = False Then Workbooks.Open FBase
Set ValMasque = ThisWorkbook.Worksheets(Masque)
Set ValBase = Workbooks(FBase).Worksheets(Base)
Ligne = LastLigne(FBase, Base)
For Boucle = LBound(Champs) To UBound(Champs)
'With Worksheets(Masque).Range(Champs(Boucle))
With ValMasque.Range(Champs(Boucle))
ValBase.Cells(Ligne, Boucle + 1).Value = .Value
End With
Next Boucle
End Sub
----------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------
MACRO(2)
Sub Enr_Fin()
ChDir "C:\Affiches"
nomrepertoire = CurDir & "\" & Range("B3").Value
If Dir(nomrepertoire, vbDirectory) <> "" Then MsgBox "Répertoire Existant, Validez par OK" Else MkDir nomrepertoire
nomsauvegarde = nomrepertoire & "\" & Range("B3").Value
ActiveWorkbook.SaveAs Filename:=nomsauvegarde, FileFormat _
:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
ChDir "C:\Eric\Mandats"
ActiveWorkbook.SaveAs Filename:=Range("B3").Value, FileFormat _
:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
MsgBox "Votre fiche est enregistrée. MERCI."
End Sub