Impossibilité de supprimé une Querytable
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
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.
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.
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