Impossibilité de supprimé une Querytable

Y compris Power BI, Power Query et toute autre question en lien avec Excel
R
Reclaimer
Jeune membre
Jeune membre
Messages : 36
Inscrit le : 7 novembre 2017
Version d'Excel : 2013 FR

Message par Reclaimer » 6 décembre 2017, 10:11

Bonjour!

J'ai un problèmes avec une macro extrêmement basique
Dans mon fichier excel j'import des fichier .log. puis je copie et j'archive la feuille dans laquelle j'ai importé mon fichier log et je vide la feuille de structure grâce à la macro suivante:
Sub RAZ_Produit()
'
' RAZ_Produit Macro
'

'
    Range("W2:W16000").Select
    Selection.QueryTable.Delete
    Selection.ClearContents
    ActiveWorkbook.RefreshAll
    
End Sub
afin de pouvoir importer un nouveau log différend du premier.
Mais voila de temps en temps la macro ne marche pas et le RefreshAll fait revenir le vieux fichier log que je voulais supprimer.
Il revient même si j'import un nouveau log par dessus et ne laisse aucune trace du nouveau log.

En bonus le code VBA d'importation du log:
'Ouverture log Fiche Machine
Option Explicit

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
         "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Type OPENFILENAME
  lStructSize As Long
  hwndOwner As Long
  hInstance As Long
  lpstrFilter As String
  lpstrCustomFilter As String
  nMaxCustFilter As Long
  nFilterIndex As Long
  lpstrFile As String
  nMaxFile As Long
  lpstrFileTitle As String
  nMaxFileTitle As Long
  lpstrInitialDir As String
  lpstrTitle As String
  flags As Long
  nFileOffset As Integer
  nFileExtension As Integer
  lpstrDefExt As String
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type

Function GetFileName(sFilter As String, sInitialDir As String, sTitle As String) As String
  Dim OpenFile As OPENFILENAME, lReturn As Long
  
  With OpenFile
    .lStructSize = Len(OpenFile)
    .lpstrFilter = sFilter
    .nFilterIndex = 1
    .lpstrFile = String(257, 0)
    .nMaxFile = Len(OpenFile.lpstrFile) - 1
    .lpstrFileTitle = OpenFile.lpstrFile
    .nMaxFileTitle = OpenFile.nMaxFile
    .lpstrInitialDir = sInitialDir
    .lpstrTitle = sTitle
    .flags = 0
  End With
  lReturn = GetOpenFileName(OpenFile)

  If lReturn = 0 Then
    GetFileName = ""
  Else
     GetFileName = Trim(OpenFile.lpstrFile)
  End If

End Function

Sub Test()
  Dim sPathFic As String, sFilter As String
  sFilter = "Fichier d'export (*.log)" & Chr(0) & "*.log" & Chr(0)
  ' Donner le choix du fichier
 sPathFic = GetFileName(sFilter, "H:\Methodes\3-Fichiers par noms\Dumortier T\relevé défaut 6 axes", "Sélectionnez le fichier à ouvrir")
  If sPathFic = "" Then Exit Sub
  '
 With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & sPathFic, Destination:=Range("$A$2"))
    .Name = "copie"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlOverwriteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 850
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1)
    .TextFileTrailingMinusNumbers = False
    .Refresh BackgroundQuery:=False
    Call Archivage
  End With
  End Sub

  'ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotCache.Refresh
  
  Sub Archivage()
Dim SHsource As Worksheet, WBcible As Workbook
 
'feuille source
Set SHsource = ThisWorkbook.Sheets("TraitLOG")
 
'classeur cible
On Error Resume Next
Set WBcible = Workbooks.Open(Filename:="autoimport-textfile\")
 
'copie de la feuille source à la fin du classeur cible
SHsource.Copy After:=WBcible.Sheets(Sheets.Count)
 
'renommer la feuille cible
WBcible.Sheets(Sheets.Count).Name = WBcible.Sheets(Sheets.Count).Cells(2, 21)
 
'fermeture et sauvegarde du classeur cible
WBcible.Close True
 
'libération de la mémoire
Set SHsource = Nothing
Set WBcible = Nothing
  Sheets("TraitLOG").Select
  Range("A2").Select
  ActiveWorkbook.RefreshAll
End Sub
Merci d'avance de vos réponses
G
GVIALLES
Membre dévoué
Membre dévoué
Messages : 754
Appréciations reçues : 66
Inscrit le : 28 novembre 2017
Version d'Excel : 2016, 360
Téléchargements : Mes applications

Message par GVIALLES » 11 décembre 2017, 11:13

Bonjour Reclaimer,

Si le problème est toujours d'actualité, je propose le code :
Sub RAZ_Produit()
'
' RAZ_Produit Macro
'

'
    With ActiveSheet.Range("A2:W16000")
    
        .QueryTable.Delete
        .ClearContents
    End With
    ActiveWorkbook.RefreshAll
    
End Sub
Il est préférable dans le code VBA d'utiliser directement un objet "range" plutôt que "selection" même si lorsque l'on passe par l'enregistrement de macro, EXCEL lui génère avec "Selection".
Dans l'adresse du range j'ai remplacé "W2" par "A2" car il m'a semblé que le querytable est positionné en A2.
Cordialement,

Gérard
R
Reclaimer
Jeune membre
Jeune membre
Messages : 36
Inscrit le : 7 novembre 2017
Version d'Excel : 2013 FR

Message par Reclaimer » 11 décembre 2017, 11:43

Bonjour!

Le problème n'est plus d'actualité mais merci de ta réponse. Le problème venait du fait que j'avait plusieurs query.tables au même endroit.
La solution que j'ai trouvé était de supprimé la première querytable dans l'onglet donné-->connexion grâce à cette macro :
  Sub RAZ_Produit()
'
' RAZ_Produit Macro
EJ:
     With ThisWorkbook.Sheets("Framework Fiche produit")
        Range("W2:W160000").Select
        On Error GoTo EH
        .QueryTables(1).Delete
        Selection.ClearContents
        ActiveWorkbook.RefreshAll
        'Set rRng = ActiveSheet.Range("W2")
    End With


    
   
GoTo EJ
EH:
   MsgBox "Suppression terminé"
EI:
'Retour fenetre en A1
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.SmallScroll Down:=-24
    
End Sub 
Lorsque que la première querytable est supprimé la deuxième devient la première et ainsi de suite jusqu'à ce qu'il n'y en ai plus à supprimer.

Encore merci de ta réponse.
Avatar du membre
yg_be
Jeune membre
Jeune membre
Messages : 21
Appréciation reçue : 1
Inscrit le : 23 février 2019

Message par yg_be » 23 février 2019, 11:09

Il est possible aussi de faire ainsi:
Option Explicit
Private Sub delete_all_qt()
Dim ws As Worksheet, qt As QueryTable
Set ws = ActiveSheet
For Each qt In ws.QueryTables
    If qt.Name <> "à garder" Then
        qt.Delete
    End If
Next qt
End Sub
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message