Bonjour à tous,
Je viens de me relancer sur un nouveau projet et j'ai besoin d'un peu d'aide sur une formule qui disparait lors d'un ajout de page pour se transformer en #REF!
Projet : Je copie des données provennant d'onglets ( une vingtaine) vers le 1er onglet nommé OFFRE DE PRIX. Afin d'eviter de sauvegarder la base, j'extrais cette première page OFFRE DE PRIX pour pouvoir la réinjecter si besoin au travers d'un USERFORM.
Jusque la ca fonctionne nickel.
Mon souci est qu'aprés l'injection de la page sauvegardée, les 20 autres onglets perdent le lien avec la formule de calcul de marge de la 1ere page qu j'ai extrée puis reinjectée.
Le lien ='OFFRE DE PRIX'!$K$60 se transfrome en =#REF!$K$60 et de même
Le lien ='OFFRE DE PRIX'!$K$61 se transfrome en =#REF!$K$61.
J'ai pourtant essayé de faire une macro pour remplacer totalement toutes formules dans le classeur, cela fonctionne en manuel mais pas en macro.
En manuel avec la fonction REMPLACER TOUT modifie tout d'un coup mais avec la macro enregistrée à la fin cela ne fonctionne pas pour tout les onglets.
Quelqu'un aurait t'il la gentillesse de m'expliquer ce qui ne va pas dans ma méthode d'extraction/injection ou dans ma formule de correction des formules
Cordialement
vjoug
Permet d'afficher les USERFORM desauvergarde et ouverture
Sub Ouverture_Sauvegarde()
UserForm1.Show 0
End Sub
Permet de lancer la sauvegarde de la page Offre de prix
Sub Sauvegarde()
Dim Newbook As Workbook
Dim fName As String
Set Newbook = Workbooks.Add
fName = Application.GetSaveAsFilename(InitialFileName:="Offre commerciale (Prix)", FileFilter:="Fichiers excel (*.xls),*.xls")
If fName <> "Faux" Then
Newbook.Title = "Offre commercial(prix)"
Newbook.SaveAs Filename:=fName
ThisWorkbook.Sheets("OFFRE DE PRIX").Copy Before:=Newbook.Sheets("feuil1")
With Newbook.Sheets("Offre de prix").PageSetup
.LeftMargin = Application.InchesToPoints(0.25) 'marge gauche
.RightMargin = Application.InchesToPoints(0.25) 'marge droite
.TopMargin = Application.InchesToPoints(0.31) 'marge haut
.BottomMargin = Application.InchesToPoints(0.31) 'marge bas
.HeaderMargin = Application.InchesToPoints(0.19) 'marge tout en haut
.FooterMargin = Application.InchesToPoints(0.19) 'marge tout en bas
'.Zoom = False
'.FitToPagesWide = 1
'.FitToPagesTall = 1
End With
Newbook.Close (True)
Else: Newbook.Close (False)
End If
End Sub
Permet d'injecter la page sauvegarder préalablement
Sub Ouverture()
Dim classeur As Workbook
Dim way As String
way = Application.GetOpenFilename(FileFilter:="Fichiers excel (*.xls),*.xls")
If way = "Faux" Then
Exit Sub
Else
Set classeur = Workbooks.Open("" & way)
With classeur
Application.DisplayAlerts = False
ThisWorkbook.Sheets("OFFRE DE PRIX").Delete
Application.DisplayAlerts = True
ThisWorkbook.Activate
.Sheets("OFFRE DE PRIX").Copy Before:=ThisWorkbook.Sheets("ACC POMPE")
.Close (True)
ActiveWindow.View = xlPageBreakPreview
End With
End If
End Sub
Permet de modifier par lot les formules erronées sur chaque onglet
Sub formuleK()
'
' formuleK Macro
' Macro enregistrée le 09/10/2011 par Vjoug
'
'
Sheets("ONGLET1").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets(Array("ONGLET1", "ONGLET2", "ONGLET3", "ONGLET4", "ONGLET5", _
"ONGLET6", "ONGLET7", "ONGLET8", "ONGLET9", "ONGLET10", _
"ONGLET11", "ONGLET1", "ONGLET8", "ONGLET9", "ONGLET10", "ONGLET11", "ONGLET12", _
"ONGLET13", "ONGLET14", "ONGLET15", "ONGLET16", "ONGLET17", "ONGLET18", "ONGLET19", _
"ONGLET1")).Select
Sheets("ONGLET1").Activate
Sheets(Array("ONGLET8", "ONGLET9", "ONGLET10", "ONGLET11", "ONGLET12", "ONGLET13", _
"ONGLET14", "ONGLET15")).Select Replace:=False
Cells.Replace What:="#REF!$K", Replacement:="'OFFRE DE PRIX'!$K", LookAt _
:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("OFFRE DE PRIX").Select
End Sub
Je viens de me relancer sur un nouveau projet et j'ai besoin d'un peu d'aide sur une formule qui disparait lors d'un ajout de page pour se transformer en #REF!
Projet : Je copie des données provennant d'onglets ( une vingtaine) vers le 1er onglet nommé OFFRE DE PRIX. Afin d'eviter de sauvegarder la base, j'extrais cette première page OFFRE DE PRIX pour pouvoir la réinjecter si besoin au travers d'un USERFORM.
Jusque la ca fonctionne nickel.
Mon souci est qu'aprés l'injection de la page sauvegardée, les 20 autres onglets perdent le lien avec la formule de calcul de marge de la 1ere page qu j'ai extrée puis reinjectée.
Le lien ='OFFRE DE PRIX'!$K$60 se transfrome en =#REF!$K$60 et de même
Le lien ='OFFRE DE PRIX'!$K$61 se transfrome en =#REF!$K$61.
J'ai pourtant essayé de faire une macro pour remplacer totalement toutes formules dans le classeur, cela fonctionne en manuel mais pas en macro.
En manuel avec la fonction REMPLACER TOUT modifie tout d'un coup mais avec la macro enregistrée à la fin cela ne fonctionne pas pour tout les onglets.
Quelqu'un aurait t'il la gentillesse de m'expliquer ce qui ne va pas dans ma méthode d'extraction/injection ou dans ma formule de correction des formules
Cordialement
vjoug
Permet d'afficher les USERFORM desauvergarde et ouverture
Sub Ouverture_Sauvegarde()
UserForm1.Show 0
End Sub
Permet de lancer la sauvegarde de la page Offre de prix
Sub Sauvegarde()
Dim Newbook As Workbook
Dim fName As String
Set Newbook = Workbooks.Add
fName = Application.GetSaveAsFilename(InitialFileName:="Offre commerciale (Prix)", FileFilter:="Fichiers excel (*.xls),*.xls")
If fName <> "Faux" Then
Newbook.Title = "Offre commercial(prix)"
Newbook.SaveAs Filename:=fName
ThisWorkbook.Sheets("OFFRE DE PRIX").Copy Before:=Newbook.Sheets("feuil1")
With Newbook.Sheets("Offre de prix").PageSetup
.LeftMargin = Application.InchesToPoints(0.25) 'marge gauche
.RightMargin = Application.InchesToPoints(0.25) 'marge droite
.TopMargin = Application.InchesToPoints(0.31) 'marge haut
.BottomMargin = Application.InchesToPoints(0.31) 'marge bas
.HeaderMargin = Application.InchesToPoints(0.19) 'marge tout en haut
.FooterMargin = Application.InchesToPoints(0.19) 'marge tout en bas
'.Zoom = False
'.FitToPagesWide = 1
'.FitToPagesTall = 1
End With
Newbook.Close (True)
Else: Newbook.Close (False)
End If
End Sub
Permet d'injecter la page sauvegarder préalablement
Sub Ouverture()
Dim classeur As Workbook
Dim way As String
way = Application.GetOpenFilename(FileFilter:="Fichiers excel (*.xls),*.xls")
If way = "Faux" Then
Exit Sub
Else
Set classeur = Workbooks.Open("" & way)
With classeur
Application.DisplayAlerts = False
ThisWorkbook.Sheets("OFFRE DE PRIX").Delete
Application.DisplayAlerts = True
ThisWorkbook.Activate
.Sheets("OFFRE DE PRIX").Copy Before:=ThisWorkbook.Sheets("ACC POMPE")
.Close (True)
ActiveWindow.View = xlPageBreakPreview
End With
End If
End Sub
Permet de modifier par lot les formules erronées sur chaque onglet
Sub formuleK()
'
' formuleK Macro
' Macro enregistrée le 09/10/2011 par Vjoug
'
'
Sheets("ONGLET1").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets(Array("ONGLET1", "ONGLET2", "ONGLET3", "ONGLET4", "ONGLET5", _
"ONGLET6", "ONGLET7", "ONGLET8", "ONGLET9", "ONGLET10", _
"ONGLET11", "ONGLET1", "ONGLET8", "ONGLET9", "ONGLET10", "ONGLET11", "ONGLET12", _
"ONGLET13", "ONGLET14", "ONGLET15", "ONGLET16", "ONGLET17", "ONGLET18", "ONGLET19", _
"ONGLET1")).Select
Sheets("ONGLET1").Activate
Sheets(Array("ONGLET8", "ONGLET9", "ONGLET10", "ONGLET11", "ONGLET12", "ONGLET13", _
"ONGLET14", "ONGLET15")).Select Replace:=False
Cells.Replace What:="#REF!$K", Replacement:="'OFFRE DE PRIX'!$K", LookAt _
:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("OFFRE DE PRIX").Select
End Sub