VBA EXCEL Problème de lien apres la copie d'une feuille

Signaler
Messages postés
5
Date d'inscription
mercredi 9 juillet 2008
Statut
Membre
Dernière intervention
11 juillet 2008
-
Messages postés
5
Date d'inscription
mercredi 9 juillet 2008
Statut
Membre
Dernière intervention
11 juillet 2008
-
Bonjour,

       J'ai fait une form, qui est attaché à un workbook, qui  prends des informations.  Par la suite du workbook original (WbOriginal) je créé un nouveau workbook (Wb). Je copie les feuilles avec les nouveaux paramètre dans acquis dans la form. Mon problème est que dans WbOriginal j'ai une feuille avec des listbox qui on comme référence un groupe de cellule nommé. Lorsque je copie la feuille dans Wb les listbox garde la référence du groupe de cellule nommé dans WbOriginal même si j'ai le même groupe de cellule nommé dans le Wb.

Voici le code complet ci-dessous. Bonne chance au coeur sensible pcq tout est dans le boutton

Private Sub Button1_Click()
Dim x As Integer
Dim y As Integer
Dim LigneACopier As Integer
Dim DefaultLoopsNumber As Integer
Dim DefaultSheetNumberInBook As Long
Dim Wb As Workbook
Dim WbOriginal As Workbook
Dim NomDuFichier As String
Dim FormuleImpedance As String
Dim CelluleCourante As Range
Dim PlageCourante As Range


'Empèche les update dans l'écran
Application.ScreenUpdating = False


Set WbOriginal = ActiveWorkbook
DefaultSheetNumberInBook = 1
DefaultLoopsNumber = 3


If NomDeLaFerme_TB.Value = "" Then
    NomDeLaFerme_TB.Value = "john Doe"
    End If
   


'Test si la valeur n'est pas vide
If NombreDeLoop_TB.Value = "" Then
    NombreDeLoop_TB.Value = DefaultLoopsNumber
        End If


'Initialisation de variable pour la création du nouveau workbook
    TodayDate = Format(Now(), "dd-mm-yy")
    TodayDateMFisrt = Format(Now(), "mm-dd-yyyy")
    chemin = ActiveWorkbook.Path
    NomDuFichier = chemin & "" & NomDeLaFerme_TB.Value & "_" & TodayDate & ".xls"
   
'minimise le nombre de feuille
    Application.SheetsInNewWorkbook = DefaultSheetNumberInBook


'Création du nouveau workbook
    Set Wb = Workbooks.Add
    Application.DisplayAlerts = False
    Wb.SaveAs (NomDuFichier)
    Application.DisplayAlerts = True


'Copy de la table Data sheet(1)
    WbOriginal.Sheets("Data").Copy before:=Wb.Sheets(1)
'Copy de la table Z Neu Table sheet(2)
    WbOriginal.Sheets("Z Neu table").Copy after:=Wb.Sheets(1)
'Copy de la table Layout sheet(3)
    WbOriginal.Sheets("Layout").Copy after:=Wb.Sheets(2)
'Copy de la table Data Logger sheet(4)
    WbOriginal.Sheets("Data Logger").Copy after:=Wb.Sheets(3)
'Copy de la table Loops sheet(5)
     WbOriginal.Sheets("Loops").Copy after:=Wb.Sheets(4)
'Rename la sheet("Loops")
    Wb.Sheets(5).Name = NombreDeLoop_TB.Value & " Loops"
   
   
'efface la feuille par défaut dans le workbook
'  On Error Resume Next
Application.DisplayAlerts = False
    Wb.Sheets(6).Delete
Application.DisplayAlerts = True
   
'Remplis les renseignements sur la feuille Z Neu Table
    Wb.Sheets("Z Neu table").Select
   
    Set CelluleCourante = Range("FarmName")
    CelluleCourante.Value = NomDeLaFerme_TB.Text
   
    Set CelluleCourante = Range("NuvoltUserName")
    CelluleCourante.Value = NuvoltEmpListBox.Value
   
    Set CelluleCourante = Range("ZneutableDate")
    CelluleCourante.Value = TodayDateMFisrt


'reprogramme les cellules pour avoir les mêmes valeurs partout
For x = 1 To 3
    For y = 1 To 3
    Wb.Sheets(2 + x).Select
    Set CelluleCourante = Range("F" & y + 1)
    CelluleCourante.Formula = "='Z Neu table'!I" & y + 1
 Next y
Next x


'Création de la table Z Neutre
Wb.Sheets("Z Neu table").Select
'Boucle de copie des lignes dans la feuille loops
For LigneACopier = 1 To ((NombreDeLoop_TB.Value - DefaultLoopsNumber))
'ligne à copier dans la section formule
    Rows(13 + LigneACopier).Select
    Selection.Insert Shift = xlDown
    CutCopyMode = False
    Rows(Selection.Row - 1).Copy
    Rows(Selection.Row).Select
    ActiveSheet.Paste
    'renommer les cellules
    Set CelluleCourante = Range("C" & LigneACopier + 13)
    CelluleCourante.Formula = "Loop " & LigneACopier + DefaultLoopsNumber
Next LigneACopier


'Création de la table Loop
Wb.Sheets(NombreDeLoop_TB.Value & " Loops").Select


'Boucle de copie des lignes dans la feuille loops
For LigneACopier = 1 To ((NombreDeLoop_TB.Value - DefaultLoopsNumber))
'ligne à copier dans la section formule
    Rows(11 + LigneACopier).Select
    Selection.Insert Shift = xlDown
    CutCopyMode = False
    Rows(Selection.Row - 1).Copy
    Rows(Selection.Row).Select
    ActiveSheet.Paste
    'renommer les cellules
    Set CelluleCourante = Range("C" & LigneACopier + 11)    CelluleCourante.Formula "Ztot  Loop " & LigneACopier + DefaultLoopsNumber & ""
    Set CelluleCourante = Range("E" & LigneACopier + 11)    CelluleCourante.Formula "Zneu  Loop " & LigneACopier + DefaultLoopsNumber & ""


'ligne à copier dans la section identification
'17 ligne de départ + 2 * ligner à copier = incérmentation de la boucle  + les lignes qui s'ajoutes à l'étape avant
    Rows(17 + 2 * LigneACopier).Select
    Selection.Insert Shift = xlDown
    CutCopyMode = False
    Rows(Selection.Row - 1).Copy
    Rows(Selection.Row).Select
    ActiveSheet.Paste
'renommer la cellule d'identification
    Set CelluleCourante = Range("C" & 17 + 2 * LigneACopier)
    CelluleCourante.Formula = "Loop " & LigneACopier + DefaultLoopsNumber
    CutCopyMode = False
Next LigneACopier


'Création des formules d'impédance
 'Faire toutes les loops
  For x = 1 To NombreDeLoop_TB.Value
    'S'assure que la formule est vide
    FormuleImpedance = "=F" & 8 + x & " + H" & 8 + x & "+(1/("
    'créé la formule FormuleImpedance. Le nombre de membre de la formule = le nombre de loop
    For y = 1 To NombreDeLoop_TB.Value
        If y <> x Then
            FormuleImpedance = FormuleImpedance & "(1/(F" & 8 + y & " + H" & 8 + y & "))"
            If y <> NombreDeLoop_TB.Value Then
                FormuleImpedance = FormuleImpedance & "+"
                End If
            End If
    Next y
    'Lors de l'écriture de la dernière ligne le + reste présent à cause du if y <> x
    If x = NombreDeLoop_TB.Value Then
        FormuleImpedance = Left(FormuleImpedance, Len(FormuleImpedance) - 1) 'efface le +
        End If
    'ferme la formule
    FormuleImpedance = FormuleImpedance & "))"
 'choisie la cellule ou écrire
 Set CelluleCourante = Range("B" & 8 + x)
 'écrit la formule dans la cellule
 CelluleCourante.Formula = FormuleImpedance
 'Fais le lien entre la table d'impédance des neutres et celle des loops
 Set CelluleCourante = Range("F" & 8 + x)
 CelluleCourante.Formula = "='Z Neu table'!S" & 10 + x
Next x


Wb.Sheets("Z Neu table").Select


Application.ScreenUpdating = True
Wb.Save
Wb.Activate
WbOriginal.Save
UserForm1.Hide
End Sub

1 réponse

Messages postés
5
Date d'inscription
mercredi 9 juillet 2008
Statut
Membre
Dernière intervention
11 juillet 2008

Merci et à la prochaine