[ J'abandone le fil.. ] Bug sur un fichier HTLM d'importation

[Guido]

Bonsoir le Forum

J'ai un bug dans le fichier ci dessous.

La macro du boutons2 bug sur une ligne de copie vers un fichier

Merci d'avance

Guido

 

[Guido]

Bonjour

Précision

Attention le bouton 1 n'étant actif qu'à partir de 10 heures !

Je Vous remercie

Guido

 

[phlaurent55]

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:

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

à+
Philippe

 

[JBARBE]

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

Bonjour à tous, Guido, Philippe,
Pour les connaisseurs ce n'est certes pas un problème !
Mais par respect de la volonté de Guido, il serait préférable de ne pas exposer le MODULE 2 !
En te remerciant à l’avance !
Bonne journée !

 

[Guido]

Bonjour a tous

Philippe,JBARBE..

Avec Excel 2003

Bouton 1 ok

Bouton 2 message 1004 je valide Fin

Je regarde la page Prono tout est OK.

Voir capture d'écran..

Par contre avec 2007 et plus

Même Bug 1004 et la rien ne s'affiche dans la page Prono.

Merci d'éclairer ma Lanterne

Guido

 

[ChTi160]

Bonjour
moi 2010 test Ok ????
import dans feuille "PRONO" depuis ficher Importé Ok
Une idee comme une autre pourquoi ne pas importer la feuille ,plutot que de copier les cellules?
Bonne fin de Journée
Amicalement
Jean marie

 

[Guido]

Re

Merci pour ta réflexion, mais peut tu me faire la macro a ton idée,,Merci d'avance

a plus

Guido

 

[ChTi160]

Re
voila ce que j'ai bidouille et qui fonctionne chez moi lol

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

à tester !
Bonne fin de Soirée
Amicalement
Jean marie

 

[JBARBE]

Bonjour à tous,
J'ai Excel 2007 comme Guido et la macro bug !
Je ne comprends pas !
@+

 

[JBARBE]

Re,
J'ai pu essayer son fichier original avec excel 2007 contenant cette macro et il n'y avait pas de problème !
Bizarre !
Bonne soirée !

 

[Guido]

Re

Le bouton n'est pas activé dans ce fichier -???

Merci de pouvoir y remédié...???

Guido

 

[JBARBE]

Re,
A noter que lorsque je fais un copier coller manuellement à partir de la feuille "index_payant", ce message s'affiche !
@+

 

[ChTi160]

Re
moi , j'ai dans mon fichier supprimé l'extension soit ".xlsx" au bout du nom du Fichier "index_payant"
remettre "index_payant.xlsx" , ca vient peut être de la pour 2007
Bonne fin de Soirée
Amicalement
Jean marie

 

[ChTi160]

Re
voila ce que j'obtiens en quelques secondes !
Bonne fin de soirée
Amicalement
Jean marie

 

[ChTi160]

re
Je viens de tester le fichier que j'ai mis ci dessus avec : w7-Office 2007
pas de problème , presque qu'instantané !
Bonne fin de Soirée
Amicalement
jean marie