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

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.

3test-usb.xlsm (21.33 Ko)
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.

Rechercher des sujets similaires à "enregistrrement xlsm xls"