skyst3f | Bonjour,
J'ai une macro qui ouvre une feuille Excel, copie cette feuille et la colle dans un autre fichier Excel. Cette opération fonctionne mais lors de la fermeture des fichiers concerné l'utilisateur à ces messages à l'écran :
et
Comment faire pour ne pas les afficher ou au pire, automatiser la réponse (non dans mon cas). Je vous donne le code de ma fonction qui copie/colle au cas où :
Code :
- Public Sub CopierFeuilleExcel(ByVal sMonBookDeCopie As String, ByVal sMonBookDeDestination As String, ByVal sNomFeuilleACopier As String, ByVal sNomFeuilleCopier As String)
- If Dir(sMonBookDeCopie) <> "" And Dir(sMonBookDeDestination) <> "" Then
- Dim xlApp As Excel.Application
- Dim xlBookDeCopie As Workbook
- Dim xlBookDeDestination As Workbook
- Dim i As Integer
- Dim j As Integer
- Dim wsExcel As Excel.Worksheet
- If sMonBookDeCopie <> sMonBookDeDestination Then
- Set xlApp = CreateObject("Excel.Application" )
- Set xlBookDeCopie = xlApp.Workbooks.Open(sMonBookDeCopie)
- Set xlBookDeDestination = xlApp.Workbooks.Open(sMonBookDeDestination)
-
- For i = 1 To xlBookDeCopie.Sheets.Count
-
- If xlBookDeCopie.Sheets(i).Name = sNomFeuilleACopier Then
-
- xlBookDeCopie.Activate
- xlBookDeCopie.Sheets(sNomFeuilleACopier).Select
- xlBookDeCopie.Sheets(sNomFeuilleACopier).Copy After:=xlBookDeDestination. _
- Sheets(xlBookDeDestination.Sheets.Count)
-
- For j = 1 To xlBookDeDestination.Sheets.Count
-
- If xlBookDeDestination.Sheets(j).Name = sNomFeuilleCopier Then
-
- MsgBox "La feuille copiée n'a pas pu être renommée, ce nom existe déjà!", vbCritical
-
- Exit For
-
- ElseIf j = xlBookDeDestination.Sheets.Count Then
-
- xlBookDeDestination.Sheets(j).Name = sNomFeuilleCopier
- xlBookDeDestination.Activate
-
- Set wsTemplate = xlBookDeDestination.Worksheets(sNomFeuilleCopier)
- 'c'est ici que l'on renseigne la plage de cellule à séléctionné, copier, puis coller dans le nouveau document
- wsTemplate.Range("G1:AW45" ).Select
- wsTemplate.Range("G1:AW45" ).Copy
- wsTemplate.Range("G1:AW45" ).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
- :=False, Transpose:=False
- ' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
- ':=False, Transpose:=False
- ' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
- ':=False, Transpose:=False
-
- End If
-
- Next j
-
- Exit For
-
- ElseIf i = xlBookDeCopie.Sheets.Count Then
-
- MsgBox "La feuille à copier n'existe pas!", vbCritical
-
- End If
-
- Next i
- Application.ScreenUpdating = False
- xlBookDeCopie.Close savechanges:=False
- 'xlBookDeCopie.Close True
- ' Application.ScreenUpdating = False
- xlBookDeDestination.Close True
- xlApp.Quit
-
- Set xlBookDeCopie = Nothing
- Set xlBookDeDestination = Nothing
- Set xlApp = Nothing
-
- ElseIf sMonBookDeCopie = sMonBookDeDestination Then
- Set xlApp = CreateObject("Excel.Application" )
- Set xlBookDeCopie = xlApp.Workbooks.Open(sMonBookDeCopie)
- For i = 1 To xlBookDeCopie.Sheets.Count
-
- If xlBookDeCopie.Sheets(i).Name = sNomFeuilleACopier Then
-
- xlBookDeCopie.Activate
- xlBookDeCopie.Sheets(sNomFeuilleACopier).Select
- xlBookDeCopie.Sheets(sNomFeuilleACopier).Copy After:=xlBookDeCopie. _
- Sheets(xlBookDeCopie.Sheets.Count)
- For j = 1 To xlBookDeCopie.Sheets.Count
-
- If xlBookDeCopie.Sheets(j).Name = sNomFeuilleCopier Then
-
- MsgBox "La feuille copiée n'a pas pu être renommée, ce nom existe déjà!", vbCritical
-
- Exit For
-
- ElseIf j = xlBookDeCopie.Sheets.Count Then
-
- xlBookDeCopie.Sheets(j).Name = sNomFeuilleCopier
-
- End If
-
- Next j
-
- Exit For
-
- ElseIf i = xlBookDeCopie.Sheets.Count Then
-
- MsgBox "La feuille à copier n'existe pas!", vbCritical
-
- End If
-
- Next i
-
- xlBookDeCopie.Close True
- xlApp.Quit
-
- Set xlBookDeCopie = Nothing
- Set xlApp = Nothing
- End If
-
- Else
- MsgBox "Le fichier n'existe pas, vérifier le chemin !", vbCritical
-
- End If
- End Sub
|
Note : cette fonction provient d'Internet (vbsources.com)
Merci d'avance. Message édité par skyst3f le 20-03-2007 à 11:21:53
|