XL 2016 Modifier une macro pour qu'elle ouvre les fichiers ".xlsm" et ".xlsx"

Aloha

XLDnaute Accro
Bonjour,
J'ai une macro bien complexe (trop complexe pour que je la comprenne vraiment) qui doit e.a. ouvrir des fichiers qui, lorsqu'elle a été rédigée, étaient des fichiers ".xls".
Cependant, elle ne veut pas ouvrir les fichiers avec les extension modernes: ".xlsx", ".xlsm" et je n'arrive pas à comprendre comment la macro devrait être modifiée pour qu'elle ouvre ces fichiers.

Voici une fonction appelée dans la macro et où je trouve des extensions ".xls".

Code:
Function simpleCellRegex(quelle As String) As String
  Dim regEx As New RegExp
  Dim strPattern As String
  Dim strInput As String
  Dim strReplace As String
  Dim strOutput As String
  Dim Zwischen As String
  
  strPattern = "\s+[A-Z]+.xls$"

  If strPattern <> "" Then
  strInput = quelle
  strReplace = ""

  With regEx
  .Global = True
  .MultiLine = True
  .IgnoreCase = False
  .Pattern = strPattern
  End With

  If regEx.test(strInput) Then
  Zwischen = regEx.Replace(strInput, strReplace)
  simpleCellRegex = Trim(Replace(Replace(strInput, Zwischen, ""), ".xls", ""))
  Else
  simpleCellRegex = ""
  End If
  End If
End Function

Est-ce que c'est bien dans cette fonction qu'il faut apporter une modification? J'ai déjà remplacé les deux ".xls" par des ".xlsx" et des ".xlsm", mais sans succès.

Bonne journée
Aloha
 

Roland_M

XLDnaute Barbatruc
Bonjour,

peut être plus simplement !?

Code:
Public Sub SelectUnFichier()
Dim Fichier$
Fichier$ = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
If LCase(Fichier$) = "faux" Then
   MsgBox "pas de fichier sélectionné !", vbInformation, ""
Else
   MsgBox Fichier$
  'pour charger le fichier
  'Workbooks.Open Fichier$
End If
End Sub
 
Dernière édition:

Aloha

XLDnaute Accro
Bonsoir,
Depuis hier j'essaye de comprendre ton code et de voir comment l'intégrer, mais je n'y arrive pas, ni l'un ni l'autre.
Dans une Sub il y a ce passage:
Code:
H = simpleCellRegex(fDatei.Name)
où cette fonction est donc appelée, et je ne sais pas comment la remplacer.

Ce code (l'ensemble) fonctionnait, mais pour une raison que je n'arrive pas à comprendre il ne fonctionne plus: il ne veut pas ouvrir les fichiers qu'il doit ouvrir. Cela me bloque énormément dans mon travail que je dois terminer pour début février.

Pour essayer de comprendre le bout de code que j'avais posté ici:
Code:
strPattern = "\s+[A-Z]+.xls$"
Que signifie le signe du dollar?
Code:
simpleCellRegex = Trim(Replace(Replace(strInput, Zwischen, ""), ".xls", ""))
Cela signifie quoi?

Bonne soirée
Aloha
 

Dranreb

XLDnaute Barbatruc
Bonsoir.
A mon avis elle ne sert à rien cette fonction simpleCellRegex.
Elle n'ouvre pas de fichier.
Et quand bien même FDatei (dont vous ne dites rien) serait un objet ayant une propriété Name représentant un nom de classeur sans son extension, et que le classeur à ouvrir peut avoir des extensions imprévisibles différentes, il n'y a qu'en faisant un NomFic = Dir(FDatei.Name & ".xl*") que vous pourriez connaitre son nom avec son extension, à condition que le dossier courant soit celui qui le contient.
 

Aloha

XLDnaute Accro
Re,
Je me demande si je ne vais pas faire tout le travail pour anonymiser les fichiers et poster le code entier, si vous voulez bien y jeter un coup d'oeil et me remettre sur la bonne voie (en modifiant le code), sinon je n'y arriverai jamais.
A+
Aloha
 

Dranreb

XLDnaute Barbatruc
C'est surtout la procédure qui ouvre le ficher qu'il faudrait voir.
Celle qui fait probablement un appel préalable à simpleCellRegex en vue peut être d'éliminer d'éventuels caractères interdits dans un nom de fichier, pouvant exister dans FDatei.Name
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, le forum

@Aloha
Comme précédemment dit, la fonction n'ouvre pas un fichier
mais utilise RegExp pour manipuler des chaines de caractères.

Normalement, la proposition de Roland_M devarit suffire pour ce qui est d'ouvrir un xls ou un xsl? , non?

PS: Tu as ouvert un fil récent sur l'ouverture d'un classeur par VBA...
https://www.excel-downloads.com/thr...as-fichiers-alors-que-bien-présents.20021992/

Voici un exemple d'utilisation de cette fonction
VB:
Sub Test()
MsgBox simpleCellRegex("12abc")
MsgBox simpleCellRegex("12ab345cd6ef")
MsgBox simpleCellRegex("abc123")
End Sub
Function simpleCellRegex(Chaine) As String
Dim strPattern$, strInput$, strReplace$, strOutput$
    strPattern = "[^0-9]" 'extrait les chiffres
    If strPattern <> "" Then
    strInput = Chaine
    strReplace = ""
        With CreateObject("VBScript.RegExp")
            .Global = True
            .MultiLine = True
            .IgnoreCase = False
            .Pattern = strPattern
        If .Test(strInput) Then
            simpleCellRegex = .Replace(strInput, strReplace)
        Else
            simpleCellRegex = "Aucune correspondance"
        End If
         End With
    End If
End Function
 

Aloha

XLDnaute Accro
Bonsoir,

En effet, le code du message #2 de Roland permet de choisir et d'ouvrir un fichier.
Deux problèmes:
1. la macro doit ouvrir un 2e fichier dont le nom est dérivé du premier (le premier s'appelle p.ex. Janvier 2017 BP et le deuxième s'appellera alors BP 2017). Elle doit copier des données du fichier mensuel -le premier-, créer au besoin une nouvelle fiche dans le fichier annuel -le second- et coller les données

2. je ne sais pas comment l'intégrer dans mon code composé de plusieurs Sub.

J'ai, en effet, ouvert divers thèmes, ces derniers temps, mais il s'agissait toujours d'une tâche différente.
Et je dois avouer que la tête me tourne avec tous mes essais et tous mes appels à l'aide.

Ma tâche serait pratiquement terminée si je ne trébuchais pas sur cette affaire-ci.

A+
Aloha
 

Aloha

XLDnaute Accro
Bonjour,
Merci bien pour vos propositions.
Je viens d'essayer encore une fois de faire tourner mon code original: avec les fichiers en ".xls" il fonctionne, mais pas avec les ".xlsx" et les ".xlsm". Si j'arrivais à détecter l'endroit précis où l'extension est définie, mon problème serait résolu.
A+
Aloha
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Il est très facile à détecter parce qu'elle n'est définie qu'à un seul endroit: dans le dossier qui le contient. Et c'est un Dir(NomDeFichierSansLExtension & ".xls*") qui permet de le retrouver.
À moins bien sûr qu'il n'existe à la fois pour un même nom un .xls, .xlsx et .xlsm
Mais alors il serait encore possible facilement de les examiner tous et de prendre celui qui a la date de modification la plus récente.
 
Dernière édition:

Aloha

XLDnaute Accro
Bonjour,

"Très facile" est très relatif!
L'endroit du code oùi il bloque en présence d'un fichier mensuel pas en ".xls":
Code:
Set Cible = Application.Workbooks.Open(Destination)
,

Ci-attachés 3 fichiers: le fichier avec les macros, un fichier mensuel et un fichier annuel.
A+
Aloha
 

Pièces jointes

  • Fichier mensuel.xlsx
    39.9 KB · Affichages: 16
  • Fichier annuel.xlsx
    193.8 KB · Affichages: 20
  • Fichier avec macros.xlsm
    18.4 KB · Affichages: 26

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, le forum

@Aloha
Remplaces ta macro Copier par celle-ci
Petit jeu en bonus: cherche ce que j'ai modifié ;)
VB:
Sub Copier()
Dim fs As Object
Dim fVerz As Object
Dim fVerzZiel As Object
Dim fDatei As Object
Dim fdateien As Object
Dim fdateienZiel As Object
Dim strDat As String
Dim Ligne As Integer
Dim Dossier As String
Set fs = CreateObject("scripting.FileSystemObject")
Dossier = ThisWorkbook.Path & "\ToBeCopied\"
Set fVerz = fs.getFolder(Dossier)
Set fdateien = fVerz.Files
Dim Service As String
Dim Destination As String

For Each fDatei In fdateien
    If InStr(fDatei, "") > 0 Then
        Ligne = Ligne + 1
         Service = simpleCellRegex(fDatei.Name)
          Destination = RechercheDossierDestination(Service)
          Copier_les_saisies Dossier + fDatei.Name, Destination
    End If
Next fDatei
End Sub
 

Aloha

XLDnaute Accro
Bonjour,
Merci beaucoup.
Tu as enlevé "\" dans la dernière instruction.
Mais, hélas cela ne change rien: j'ai le même message d'erreur!
Ce qui peut paraître bizarre c'est que Excel trébuche sur la cible, alors que l'instruction définissant la source la précède.
A+
Aloha
 

Discussions similaires

Statistiques des forums

Discussions
311 733
Messages
2 082 009
Membres
101 865
dernier inscrit
MLL