MODULE 1
Attribute VBA_ModuleType=VBAModule
Sub Module1
Option Explicit
Sub Copie_Fichier()
Dim WbSrce As Workbook, WbDest As Workbook, WbFile As Variant
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each WbFile In Workbooks
If WbFile.Name Like "www.GentleSource.com_File_Download_Script*" Or _
WbFile.Name Like "index_payant*" Then
Set WbSrce = WbFile
Set WbDest = ThisWorkbook
Exit For
End If
Next WbFile
If WbSrce Is Nothing Then
WbFile = Application.GetOpenFilename _
("Fichiers Excel (*.xlsx),*.xlsx", , "Sélectionnez le fichier :")
If VarType(WbFile) = vbBoolean Then
MsgBox "Action Annulé": Exit Sub
Else
Set WbSrce = Workbooks.Open(WbFile)
Set WbDest = ThisWorkbook
End If
End If
With WbDest.Sheets("PRONO")
.Cells.Delete
WbSrce.Sheets("Forme et Classe").Cells.Copy .Range("A1")
WbSrce.Close False
.Cells.UnMerge
.Columns("A:A").Insert
End With
Set WbSrce = Nothing
Set WbDest = Nothing
Sheets("Menu").Select
Range("A1").Select
MsgBox "Récupération Prono Terminé "
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
End Sub
MODULE 2
Attribute VBA_ModuleType=VBAModule
Sub Module2
Sub CButUpload_Click()
'Ancienne méthodeaccès au site WEB
'ActiveWorkbook.FollowHyperlink "http://trading-courses.ovh/main_root/logiciel/courses.php"
'
'Méthode maintenant utilisée
'http://trading-courses.ovh/main_root/download_center/index_payant.php?excel-24-11-2016.xlsx
Dim Wb As Workbook
Set Wb = ThisWorkbook
Workbooks.Open Filename:="http://trading-courses.ovh/main_root/download_center/index_payant.php?excel-" _
& Format(Now, "dd-mm-yyyy") & ".xlsx"
Wb.Activate
Set Wb = Nothing
MsgBox "FIN"
End Sub
End Sub
Bonjour à tous, Guido, Philippe,Bonjour Guido,
Avec un mot de passe sur la macro ce sera difficile de te venir en aide
Mais il ne faut pas perdre de vue qu'un code protégé avec Excel n'est pas une garantie de sécurité
en voici la preuve:
à+
Philippe
Private Sub CButUpload_Click()
'Ancienne méthodeaccès au site WEB
'ActiveWorkbook.FollowHyperlink "http://trading-courses.ovh/main_root/logiciel/courses.php"
'Méthode maintenant utilisée
'http://trading-courses.ovh/main_root/download_center/index_payant.php?excel-24-11-2016.xlsx
Dim Wb As Workbook
Set Wb = ThisWorkbook
Workbooks.Open Filename:="http://trading-courses.ovh/main_root/download_center/index_payant.php?excel-" _
& Format(Now, "dd-mm-yyyy") & ".xlsx"
‘******************************
ImportFeuilleProno 'qui peut surement être améliorée
‘******************************
MsgBox "FIN"
End Sub
Sub ImportFeuilleProno() 'Macro d'import de la feuille Source
Dim Ws_S As Worksheet
Dim Ws_C As Worksheet
Dim WkB_S As Workbook
Dim WkB_C As Workbook
Const StrName As String = "PRONO" ‘futur Nom de la feuille Importée
With Application
.ScreenUpdating = False 'inhibe la mise à jour des fenêtres
.DisplayAlerts = False ‘Inhibe les messages d’alerte
End With
Set WkB_C = ThisWorkbook ‘On affecte le Classeur à la variable
On Error Resume Next 'évite l'erreur si la feuille n'existe pas déjà
WkB_C.Worksheets(StrName).Delete 'On supprime la feuille "PRONO"
On Error GoTo 0 'on réinitialise la gestion des erreurs
Set Ws_C = WkB_C.Sheets(WkB_C.Sheets.Count) 'feuille après laquelle la feuille "PRONO" va être inserée
Set WkB_S = Workbooks("index_payant") 'on définit le Classeur source
Set Ws_S = WkB_S.Sheets(1) 'ON détermine la feuille qui va être copiée vers
'*****************
Ws_S.Copy After:=Ws_C 'On fait une copie de la feuille Source vers le Classeur Cible
'*****************
WkB_S.Close False 'On ferme le Classeur Source sans enregistrer
With WkB_C 'Avec le Classeur Cible
With .Sheets(.Sheets.Count) 'avec la dernière feuille celle ajoutée
.Name = StrName 'On renomme le feuille importée
End With
End With
With Application
.ScreenUpdating = True 'réinitialise la mise a jour des fenêtres
.DisplayAlerts = True 'et les message s d'erreur eventuels
End With
End Sub