Enregistrrement xlsm en xls
Bonjour à tous,
Après avoir résolu le PB d'écriture de fichier sur le serveur et ce grâce à votre aide, je vous sollicite de nouveau car j'ai une incompréhension de le message visant la ligne " Set wb = Workbooks.Open(Filename:=Chemin & "ETIQUETTE.xlsm")"
Private Sub CommandButton6_Click()
Dim Chemin As String, Fichier As String, lettre As String
Dim wb As Workbook
Dim FSO As Object
Dim Drv As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
With ThisWorkbook.Worksheets("ETIQUETTE")
.Columns(1).Copy
.Columns(6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Columns(2).Copy
.Columns(8).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Columns(1).Clear
.Columns(2).Clear
.Columns(3).Clear
.Columns(4).Clear
.Columns(5).Clear
End With
For Each Drv In FSO.Drives
With Drv
If .IsReady And .DriveType = 1 Then
'MsgBox "Lecteur USB sur : " & .DriveLetter
lettre = Drv.DriveLetter
Chemin = lettre & ":\"
Fichier = "ETIQUETTE"
ThisWorkbook.Worksheets("ETIQUETTE").Copy 'Sheets("ETIQUETTE").Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveCopyAs Filename:=Chemin & Fichier & ".xls", FileFormat:=-4143, CreateBackup:=False ' Filename:=Chemin & Fichier & ".xlsm"
ActiveWorkbook.Close
Set wb = Workbooks.Open(Filename:=Chemin & "ETIQUETTE.xlsm")
With wb
.SaveAs Filename:=Chemin & Fichier & ".xls", FileFormat:=-4143, CreateBackup:=False
.Close
End With
ActiveWorkbook.Close savechanges:=True
Application.DisplayAlerts = True
Exit Sub
End If
End With
Next Drv
MsgBox "Pas de clé USB détectée. Merci d'en insérer une !"
End Sub
Quelqu'un aurait-il une idée du blocage.
Merci de votre aide
Bonjour,
Est ce que cette macro est dans le fichier ETIQUETTE.xlsm ?
Bonjour,
Désolé de cette réponse tardive.
Oui cette macro est bien dans le fichier ETIQUETTE.xlsm
Vous avez une orientation à me donner?
Cordialement
Bonjour,
Oui cette macro est bien dans le fichier ETIQUETTE.xlsm
alors cette ligne est inutile, puisque celui-ci est toujours ouvert,
Set wb = Workbooks.Open(Filename:=Chemin & "ETIQUETTE.xlsm")
Bonjour,
Merci pour ce retour.
Ce qui veut dire que la ligne au dessus considere le premier fichier en fermeture et non etiquette.
Je supprime la ligné ´ set ´et vous tiens informé Lundi
Bon weekend
Ce qui veut dire que la ligne au dessus considere le premier fichier en fermeture et non etiquette.
Puisqu'auparavant vous avez copié un onglet dans un nouveau classeur,
à ce moment, c'est le nouveau classeur qui devient le classeur actif (ActiveWorkbook) et non le classeur "ETIQUETTE.xlsm"
c'est le nouveau classeur qui est enregistrer et puis fermé
'copié un onglet dans un nouveau classeur
ThisWorkbook.Worksheets("ETIQUETTE").Copy 'Sheets("ETIQUETTE").Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveCopyAs Filename:=Chemin & Fichier & ".xls", FileFormat:=-4143, CreateBackup:=False ' Filename:=Chemin & Fichier & ".xlsm"
ActiveWorkbook.Close
Édit: au cas ou il y aurait plusieurs classeurs ouvert vous devriez attribuer une référence d'objet au classeur "ETIQUETTE" en début de macro (après les déclarations)
Set wk = Workbooks("ETIQUETTE")
'ou bien
Set wk = ThisWorkbook
de cette façon vous pourrez rappeler ce classeur par la suite
wk.Activate
Bonjour,
Comme vous me l'avez indiqué, j'ai supprimé la ligne cependant un nouveau message d'erreur apparait, fileformat inconnu
Voici le code :
Private Sub CommandButton6_Click()
Dim Chemin As String, Fichier As String, lettre As String
Dim wb As Workbook
Dim FSO As Object
Dim Drv As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
With ThisWorkbook.Worksheets("ETIQUETTE")
.Columns(1).Copy
.Columns(6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Columns(2).Copy
.Columns(8).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Columns(1).Clear
.Columns(2).Clear
.Columns(3).Clear
.Columns(4).Clear
.Columns(5).Clear
End With
For Each Drv In FSO.Drives
With Drv
If .IsReady And .DriveType = 1 Then
lettre = Drv.DriveLetter
Chemin = lettre & ":\"
Fichier = "ETIQUETTE"
ThisWorkbook.Worksheets("ETIQUETTE").Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveCopyAs Filename:=Chemin & Fichier & ".xls", FileFormat:=-4143, CreateBackup:=False
'ActiveWorkbook.Close
' Set wb = Workbooks.Open(Filename:=Chemin & "ETIQUETTE.xlsm")
'With wb
' .SaveAs Filename:=Chemin & Fichier & ".xls", FileFormat:=-4143, CreateBackup:=False
' .Close
'End With
ActiveWorkbook.Close savechanges:=True
Application.DisplayAlerts = True
Exit Sub
End If
End With
Next Drv
MsgBox "Pas de clé USB détectée. Merci d'en insérer une !"
End Sub
Avez vous une idée le pourquoi du blocage ?
Merci de votre aide
51 = xlOpenXMLWorkbook (without macro's in 2007-2016, xlsx)
52 = xlOpenXMLWorkbookMacroEnabled (with or without macro's in 2007-2016, xlsm)
50 = xlExcel12 (Excel Binary Workbook in 2007-2016 with or without macro's, xlsb)
56 = xlExcel8 (97-2003 format in Excel 2007-2016, xls)
pour un format ".xls" le numéro est 56
ActiveWorkbook.SaveCopyAs Filename:=Chemin & Fichier & ".xls", FileFormat:=56, CreateBackup:=False
Malheuresement, j'ai toujours le message d'erreur
Erreur de compilation, Argument nommé introuvable
Et avec FileFormat surligné en bleu.
Là ?
Merci de votre aide
Private Sub CommandButton6_Click()
Dim Chemin As String, Fichier As String, lettre As String
Dim wb As Workbook
Dim FSO As Object
Dim Drv As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
With ThisWorkbook.Worksheets("ETIQUETTE")
.Columns(1).Copy
.Columns(6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Columns(2).Copy
.Columns(8).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Columns(1).Clear
.Columns(2).Clear
.Columns(3).Clear
.Columns(4).Clear
.Columns(5).Clear
End With
For Each Drv In FSO.Drives
With Drv
If .IsReady And .DriveType = 1 Then
lettre = Drv.DriveLetter
Chemin = lettre & ":\"
Fichier = "ETIQUETTE"
ThisWorkbook.Worksheets("ETIQUETTE").Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveCopyAs Filename:=Chemin & Fichier & ".xls", FileFormat:=56, CreateBackup:=False
'ActiveWorkbook.Close
' Set wb = Workbooks.Open(Filename:=Chemin & "ETIQUETTE.xlsm")
'With wb
' .SaveAs Filename:=Chemin & Fichier & ".xls", FileFormat:=-4143, CreateBackup:=False
' .Close
'End With
ActiveWorkbook.Close savechanges:=True
Application.DisplayAlerts = True
Exit Sub
End If
End With
Next Drv
MsgBox "Pas de clé USB détectée. Merci d'en insérer une !"
End Sub
Est-ce que le chemin de Chemin & Fichier & ".xls"
est un emplacement valide ?
lettre = Drv.DriveLetter
Chemin = lettre & ":\"
Fichier = "ETIQUETTE"
ActiveWorkbook.SaveCopyAs Filename:=Chemin & Fichier & ".xls", FileFormat:=56, CreateBackup:=False
Oui,
Il est sur une clé USB dont le chemin est défini au dessus.
Serait-ce la raison?
pouvez-vous faire un test en modifiant pour "F" avec la bonne lettre
c'est pour vérifier que le problème ne vient pas des variables.
sub test()
ActiveWorkbook.SaveCopyAs Filename:= "F:\ETIQUETTE.xls", FileFormat:=56, CreateBackup:=False
End If
Non,
Même message.
Private Sub CommandButton6_Click()
Dim Chemin As String, Fichier As String, lettre As String
Dim wb As Workbook
Dim FSO As Object
Dim Drv As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
With ThisWorkbook.Worksheets("ETIQUETTE")
.Columns(1).Copy
.Columns(6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Columns(2).Copy
.Columns(8).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Columns(1).Clear
.Columns(2).Clear
.Columns(3).Clear
.Columns(4).Clear
.Columns(5).Clear
End With
For Each Drv In FSO.Drives
With Drv
If .IsReady And .DriveType = 1 Then
lettre = Drv.DriveLetter
Chemin = lettre & ":\"
Fichier = "ETIQUETTE"
ThisWorkbook.Worksheets("ETIQUETTE").Copy
Application.DisplayAlerts = False
'ActiveWorkbook.SaveCopyAs Filename:=Chemin & Fichier & ".xls", FileFormat:=56, CreateBackup:=False
ActiveWorkbook.SaveCopyAs Filename:="F:\ETIQUETTE.xls", FileFormat:=56, CreateBackup:=False
'ActiveWorkbook.Close
' Set wb = Workbooks.Open(Filename:=Chemin & "ETIQUETTE.xlsm")
'With wb
' .SaveAs Filename:=Chemin & Fichier & ".xls", FileFormat:=-4143, CreateBackup:=False
' .Close
'End With
ActiveWorkbook.Close savechanges:=True
Application.DisplayAlerts = True
Exit Sub
End If
End With
Next Drv
MsgBox "Pas de clé USB détectée. Merci d'en insérer une !"
End Sub
Bonjour,
Voir la méthode SaveCopyAs.
https://msdn.microsoft.com/fr-fr/VBA/Excel-VBA/articles/workbook-savecopyas-method-excel
Cdlt.
pouvez-vous faire un test avec l'enregistreur de macro,
action ->enregistrer un classeur sur votre clé USB
et me montrer le code résultant.
Bonjour,
Pour le reste de la ligne ? fileformat:=56 plus besoin de spécifier?
Re,
Bonjour sabV,
A tester.
Cdlt.
Public Sub SaveWorkbookInUSB()
Dim sPath As String, sFilename As String, Letter As String
Dim FSO As Object, Drv As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each Drv In FSO.drives
With Drv
If .isready And .drivetype = 1 Then
Letter = Drv.driveletter
sPath = Letter & ":\"
sFilename = "Test_1" & ".xls"
Exit For
End If
End With
Next Drv
ThisWorkbook.Worksheets(1).Copy
With ActiveWorkbook
.SaveCopyAs Filename:=sPath & sFilename
.Close False
End With
End Sub
Jean-Eric,
Test effectué. Ecriture du fichier ok sur la clé USB, cependant, message d'erreur lors que je veux ouvrir le fichier test1. Mauvaise extension.
Private Sub CommandButton6_Click()
Dim Chemin As String, Fichier As String, lettre As String
Dim wb As Workbook
SaveWorkbookInUSB
'Dim FSO As Object
' Dim Drv As Object
' Set FSO = CreateObject("Scripting.FileSystemObject")
' With ThisWorkbook.Worksheets("ETIQUETTE")
' .Columns(1).Copy
' .Columns(6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
' .Columns(2).Copy
' .Columns(8).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
' .Columns(1).Clear
' .Columns(2).Clear
' .Columns(3).Clear
' .Columns(4).Clear
' .Columns(5).Clear
' End With
' For Each Drv In FSO.drives
' With Drv
' If .isready And .drivetype = 1 Then
'
' lettre = Drv.driveletter
' Chemin = lettre & ":\"
' Fichier = "ETIQUETTE"
' ThisWorkbook.Worksheets("ETIQUETTE").Copy
' Application.DisplayAlerts = False
'ActiveWorkbook.SaveCopyAs Filename:=Chemin & Fichier & ".xls", FileFormat:=56, CreateBackup:=False
' ActiveWorkbook.SaveCopyAs "F:\ETIQUETTE.xls" ', FileFormat:=56, CreateBackup:=False
'ActiveWorkbook.Close
' Set wb = Workbooks.Open(Filename:=Chemin & "ETIQUETTE.xlsm")
'With wb
' .SaveAs Filename:=Chemin & Fichier & ".xls", FileFormat:=-4143, CreateBackup:=False
' .Close
'End With
' ActiveWorkbook.Close savechanges:=True
' Application.DisplayAlerts = True
' Exit Sub
' End If
' End With
' Next Drv
' MsgBox "Pas de clé USB détectée. Merci d'en insérer une !"
End Sub
Public Sub SaveWorkbookInUSB()
Dim sPath As String, sFilename As String, Letter As String
Dim FSO As Object, Drv As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each Drv In FSO.drives
With Drv
If .isready And .drivetype = 1 Then
Letter = Drv.driveletter
sPath = Letter & ":\"
sFilename = "Test_1" & ".xls"
Exit For
End If
End With
Next Drv
ThisWorkbook.Worksheets(1).Copy
With ActiveWorkbook
.SaveCopyAs Filename:=sPath & sFilename
.Close False
End With
End Sub
Avec l'extension fileformat:=56, je pensais que cela suffisait! mais toujours en blocage
Je serai en déplacement demain, Ne vous offusquez pas si je ne répond que le soir ou bien mercredi matin.
Dans tous les cas, Un grand merci pour votre aide précieuse.
Re,
Ce qui signifie peut-être que la métode n'est pas adaptée à ce que tu veux faire.
Cdlt.