Comment supprimer une partie d'une formule en VBA

Version imprimable

15/09/2014, 22h20
legethi

Comment supprimer une partie d'une formule en VBA

Bonjour,

Je bute sur un prb. J'ai une formule basé sur le nom de feuille (nom différent sans format similaire donc range sur feuille non possible à ma connaissance mais je me trompe peut être) et je cherche le moyen de pouvoir supprimer une partie de la formule correspondant à la feuille que je supprime. Pour infos, je suis plus que novice en développement.

Ma formule correspond à ceci:

Code:

=SUM('SAL Gateway'!B46+'SAL Policy Server'!B46+PIM!B46+SIPCAN!B46+MYSYSLOG!B46+'XP windows 7'!B46+'Efficient SDS250'!B46+Sniffer!B46+CMTB!B46+'HTTP SFTP'!B46+'System Manager'!B46+SMOKEPING!B46+'test remove vm'!B46)

Admettons que je doivent supprimer dans cette formule la partie suivante:

Code:

+CMTB!B46

et donc ma formule deviens

Code:

../Sniffer!B46+'HTTP SFTP'!B46+/..

au lieu de

Code:

../Sniffer!B46+CMTB!B46+'HTTP SFTP'!B46+/..

J'ai un bout de code VBA qui me permet déjà de lister toutes mes feuilles puis me permet de selectionner la feuille que je veux supprimer. Ce qui fonctionne trés bien, mais me reste à intégrer la partie pour effacer dans la formule la partie en relation avec la feuille à supprimer. et là je ne trouve pas comment faire. Toutes les recherches que j'ai faite me font pointé sur effacé ce qui est à droite, au milieu ou à gauche mais rien pour effacer la partie qui m'interresse pouvant ce trouver n'importe ou dans ma formule.

Merci par avance de votre aide.
Cordialement
Thibaut

Bonjour,

Tu peux utiliser cet exemple de code qui effectue la modification souhaitée dans la formule contenue en Feuil1!A1
Code:

1 2 3 4 5 6 7 Sub Test1() Dim Texte As String Texte = "+CMTB!B46" With Worksheets("Feuil1") .Range("A1").Formula = Split(.Range("A1").Formula, Texte)(0) & Split(.Range("A1").Formula, Texte)(1) End With End Sub
Cordialement.

1 pièce(s) jointe(s)

Bonjour gFZT82,

Merci pour ta solution. Je l'ai testé en indépendant et celà fonctionne bien. Par contre pour l'intégrer à mon besoin, je dois récupérer le nom de la feuille que l'utilisateur voudras supprimé. Pour cette partie, j'ai utiliser dans un premier temps la fonction printdlg pour me lister toutes les feuilles du classeurs puis de laisser le choix à l'utilisateur de selectionner la feuille à supprimer.
Ci aprés la fin du code utiliser avec le tiens intégerer:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
FeuilleDépart.Activate
    Application.ScreenUpdating = True
    If SheetCount <> 0 Then
      If PrintDlg.Show Then
        Application.ScreenUpdating = False
        For i = 1 To SheetCount
          If PrintDlg.OptionButtons(i).Value = xlOn Then
            Worksheets(PrintDlg.OptionButtons(i).Caption).Delete
 
    Param1 = PrintDlg.OptionButtons(i).Text
    Param2 = "+ '" & Param1 & "' !C4"
 
    With Worksheets("Physical Server capacity")
        .Range("C4").Formula = Split(.Range("C4").Formula, Param2)(0) & Split(.Range("C4").Formula, Param2)(1)   '=> L'erreur pointe sur cette ligne.
        End With
          End If
        Next i
      End If
    Else
        MsgBox "Toutes les feuilles sont vides."
    End If
 
'   Supprime la feuille de dialogue temporaire (sans message d'avertissement)
    Application.DisplayAlerts = False
    PrintDlg.Delete
End Sub

Quand je fait mon teste, j'ai ce message d'erreur:

Pièce jointe 156551

J'ai essayé une autre solution en créant la feuille de dialogue avec la liste de feuille mais même résultat. Ci aprés le code utilisé par la deuxieme solution:
Module de listage de feuille:

Module get option:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub test()
Dim Ops() As Variant, Cnt As Integer, i As Integer, UserChoice As Variant, Texte As String, Texte1 As String
 
'Dim Texte As String
 
i = 1
Cnt = Sheets.Count
ReDim Ops(1 To Cnt)
For Each ws In ActiveWorkbook.Worksheets
Ops(i) = ws.Name
i = i + 1
Next ws
UserChoice = GetOption(Ops, 1, "Choose a worksheet")
If UserChoice = False Then
Exit Sub
Else
Texte1 = Sheets(Ops(UserChoice)).Texte
'Text = "+ '" & Text & "' !B26"
Texte = "+'Texte1'!B46"
 
With Worksheets("Physical Server capacity")
       .Range("C4").Formula = Split(.Range("C4").Formula, Texte)(0) & Split(.Range("C4").Formula, Texte)(1)
       End With
Sheets(Ops(UserChoice)).Delete
End If
 
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
Option Explicit
 
'Passed back to the function from the UserForm
Public GETOPTION_RET_VAL As Variant
 
Function GetOption(OpArray, Default, Title)
    Dim TempForm  'As VBComponent
    Dim NewOptionButton As Msforms.OptionButton
    Dim NewCommandButton1 As Msforms.CommandButton
    Dim NewCommandButton2 As Msforms.CommandButton
    Dim TextLocation As Integer
    Dim X As Integer, i As Integer, TopPos As Integer
    Dim MaxWidth As Long
    Dim WasVisible As Boolean
 
'   Hide VBE window to prevent screen flashing
    Application.VBE.MainWindow.Visible = False
 
'   Create the UserForm
    Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
    TempForm.Properties("Width") = 800
 
'   Add the OptionButtons
    TopPos = 4
    MaxWidth = 0 'Stores width of widest OptionButton
    For i = LBound(OpArray) To UBound(OpArray)
        Set NewOptionButton = TempForm.Designer.Controls.Add("forms.OptionButton.1")
        With NewOptionButton
            .Width = 800
            .Caption = OpArray(i)
            .Height = 15
            .Left = 8
            .Top = TopPos
            .Tag = i
            .AutoSize = True
            If Default = i Then .Value = True
            If .Width > MaxWidth Then MaxWidth = .Width
        End With
        TopPos = TopPos + 15
    Next i
 
'   Add the Cancel button
    Set NewCommandButton1 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
    With NewCommandButton1
        .Caption = "Cancel"
        .Height = 18
        .Width = 44
        .Left = MaxWidth + 12
        .Top = 6
    End With
 
'   Add the OK button
    Set NewCommandButton2 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
    With NewCommandButton2
        .Caption = "OK"
        .Height = 18
        .Width = 44
        .Left = MaxWidth + 12
        .Top = 28
    End With
 
'   Add event-hander subs for the CommandButtons
    With TempForm.CodeModule
        X = .CountOfLines
        .InsertLines X + 1, "Sub CommandButton1_Click()"
        .InsertLines X + 2, "  GETOPTION_RET_VAL=False"
        .InsertLines X + 3, "  Unload Me"
        .InsertLines X + 4, "End Sub"
 
        .InsertLines X + 5, "Sub CommandButton2_Click()"
        .InsertLines X + 6, "  Dim ctl"
        .InsertLines X + 7, "  GETOPTION_RET_VAL = False"
        .InsertLines X + 8, "  For Each ctl In Me.Controls"
        .InsertLines X + 9, "    If ctl.Tag <> """" Then If ctl Then GETOPTION_RET_VAL = ctl.Tag"
        .InsertLines X + 10, "  Next ctl"
        .InsertLines X + 11, "  Unload Me"
        .InsertLines X + 12, "End Sub"
    End With
 
'   Adjust the form
    With TempForm
        .Properties("Caption") = Title
        .Properties("Width") = NewCommandButton1.Left + NewCommandButton1.Width + 10
        If .Properties("Width") < 160 Then
            .Properties("Width") = 160
            NewCommandButton1.Left = 106
            NewCommandButton2.Left = 106
        End If
        .Properties("Height") = TopPos + 24
    End With
 
'   Show the form
    VBA.UserForms.Add(TempForm.Name).Show
 
'   Delete the form
    ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm
 
'   Pass the selected option back to the calling procedure
    GetOption = GETOPTION_RET_VAL
End Function

J'ai essayé plusieur options dans le choix de la récup du nom de la feuille et d'intégerer le + en début et !B46 à la fin.
Merci par avance de ton aide
Thibaut

18/09/2014, 09h52
gFZT82

Bonjour,

A priori, la valeur de la variable Param2 ne se trouve pas à l'identique dans la formule contenue par la cellule C4.
Quelle est la valeur exacte de Param2 ?
Quelle est la formule exacte de C4 ?

Cordialement.
18/09/2014, 15h59
legethi

Bonjour,
La formule exacte ce trouve dans l'origine de ma question mais je la remet en dessous pour aller plus vite:

Code:

=SUM('SAL Gateway'!B46+'SAL Policy Server'!B46+PIM!B46+SIPCAN!B46+MYSYSLOG!B46+'XP windows 7'!B46+'Efficient SDS250'!B46+Sniffer!B46+CMTB!B46+'HTTP SFTP'!B46+'System Manager'!B46+SMOKEPING!B46+'test remove vm'!B46)

Cet formule est updater par un code lors de la creation d'une nouvelle feuille afin d'y contenir le nom de cette feuille et avoir un resultat updater.
Ce que je cherche donc à faire maintenant, c'est un code qui me permet de supprimer si besoin une feuille et donc lors de la suppression de cette feuille mettre à jour ma formule en C4.
Dans les 2 type de code de suppression j'essaye de récupérer le nom de la feuille sellectionner afin de fournir à ta partie de code le bon nom a supprimer dans ma formule mais doit inclure un + au début et finir par !b46. Le nom de mes feuilles peuvent contenir des espaces.
Cordialement
Thibaut
18/09/2014, 19h40
eriiic

Bonjour,

une suggestion : si je ne m'abuse tu peux utiliser une somme 3D.

Tu crées une feuille 'Début', une feuille 'Fin' (même masquées) et tu mets tes feuilles à sommer entre les 2.
Ta formule devient =SOMME(Début:Fin!B46) et n'est plus à reprendre quelles que soient les feuilles ajoutées ou supprimées entre ces 2 là.

eric

Bonjour,

Le souci est effectivement lié au fait que, le nom de la feuille doit être encadré par des cotes lorsque le nom contient un espace.
Une solution consiste donc à vérifier si le nom de feuille contient un espace (avec la fonction Instr par exemple) et adapter le texte en conséquence.
J’ai testé cette solution avec le nom de la feuille en D48 :
Code:

1 2 3 4 5 6 7 8 9 10 11 Sub Essai() Dim Texte As String With Worksheets("Test") If InStr(.Range("D48").Value, " ") > 0 Then Texte = "+'" & .Range("D48").Value & "'!B46" Else Texte = "+" & .Range("D48").Value & "!B46" End If .Range("B49").Formula = Split(.Range("B48").Formula, Texte)(0) & Split(.Range("B48").Formula, Texte)(1) End With End Sub
A noter que le test n’est pas suffisant si tu dois envisager la suppression de la première feuille puisque le signe + est absent.

Cordialement.

18/09/2014, 23h42
legethi

Super, celà fonctionne Eriic.
Merci beaucoup de ton aide.
Je vais quand même essayer la solution de gFZT82 car j'aime apprendre de nouvelles choses :lol:
Cordialement
Thibaut
18/09/2014, 23h46
eriiic

Tu as lu ça : http://www.developpez.net/forums/d14...a/#post7969881 ?
eric
19/09/2014, 00h00
legethi
gFZT82,

Merci pour ta solution.
J'ai juste une question par rapport à ton code, B48, celà ne devrais pas plutôt être D48 et B49, est ce bien la cellule ou je dois avoir ma formule.
Ai je bien compris le principe?
Code:

1 2 .Range("B49").Formula = Split(.Range("B48").Formula, Texte)(0) & Split(.Range("B48").Formula, Texte)(1)
19/09/2014, 00h23
eriiic

gFZT82 fait ce que tu as demandé.
Pourquoi faire simple quand on peut faire compliqué ;-)
eric
19/09/2014, 09h48
gFZT82

Bonjour,

Dans l'instruction proposée

Code:

.Range("B49").Formula = Split(.Range("B48").Formula, Texte)(0) & Split(.Range("B48").Formula, Texte)(1)

La formule initiale se trouve en B48 et le résultat en B49.
J'ai utilisé deux cellules distinctes pour comparer les deux formules.
De plus, j'ai placé le nom de la feuille en D48 pour effectuer le test avec différents noms de feuille.

Pour modifier directement la formule initiale, j'aurais écrit :

Code:

.Range("B48").Formula = Split(.Range("B48").Formula, Texte)(0) & Split(.Range("B48").Formula, Texte)(1)

Cela dit, si toutes tes feuilles à traiter (et seulement ces feuilles) se trouvent entre une feuille de début et une feuille de fin, la solution proposée par eriiic est nettement plus simple.
Reste à voir si tu es joueur ou pas ;)

Cordialement.
19/09/2014, 20h34
legethi

Merci a vous 2 pour votre aide et m'avoir montrer comment faire simple et compliqué aussi :ptdr:
J'aime bien compliqué les choses pour être honnête :oops:
Mon code fonctionne maintenant aussi bien pour l'ajout de nouvelle sheet avec mise à jour de mes 2 formules (Et oui j'en ai 2 pas une mais elle sont identique) l'une donne donne le besoin physique de disque dur nécessaire pour supporté les différentes machines virtuelles qui me sert de base pour définir le nombre de disque dur et leur capacité réelle en fonction du type de raide choisis et l'autre me détermine la capacité en mémoire nécessaire pour chaque VM.
Concernant ton point par rapport au faite que si je veux effacer la premiere feuille le plus poserai un prb, en faite je contourne le prb d'une autre façon, cette premiere VM est mandatorie et donc doit en tous les cas existé, donc quand je fais ma liste de feuille pour l'afficher dans un dialogue box, je donne dans ma boucle la valeur de 6 à i, de cette manière je commence à lister les machine virtuelle qu'a partir de la seconde donc l'utilisateur ne peux effacer la premiere :lol:
Merci encore beaucoup
Bon Week end
Cordialement
Thibaut