IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Modification code


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre confirmé
    Inscrit en
    Janvier 2011
    Messages
    97
    Détails du profil
    Informations forums :
    Inscription : Janvier 2011
    Messages : 97
    Par défaut Modification code
    Bonjour

    voila j'ai commencé un code et je n'arrive pas à le finir ayant pour delai lundi j'ai vraiment besoin d un gros coup de main .....

    voila le but du programme :

    - en faite il faut que quand je sélectione une cellule ou plusieurs avec ctrl+clik dans la page 2401 colone D (sachant que tous les jours je rajoute une page comme la page 2401 donc faudrait que dans la page suivante et x pages apres la macro marche pour chaque nouvelles pages)

    - les données correspondantes a chaque cellules cliquées colonne D soient rassemblées pour chaque operation CLI REC PAY SF VD .... RATE

    - et ensuite réaliser chaque ticket (=petit tableau) comme le tableau (de référence) page nommée REF pour chaque opérations cliquées

    - chaque page sera nommée par le numéro correspondant du Ticket dans la cellule de la ligne i .... si je sélectione D27 et D30 , la macro devra créer un onglet nommé par le contenu de la cellule D27 avec le ticket correspondant au données de la ligne 27 page 2401 et un onglet nommé par le contenu de la cellule D30 et contenir le petit tableau avec chaque donnée de la ligne D30 page 2401


    ---
    Concernant le tableau du ticket il faut qu'il y ait 4 decimales, pas de nombre négatif et

    en ce qui concerne les noms, a côté de my eur et my usd (faut laisser la formule associant le "my" et le "their" avec la devise )
    pour les céllules B14 et B15 resteront inchangées dans tous les nouveaux tickets ...


    les noms en (C14; D14) et (C15;D15), les 2 dernières cellules du petit tableau ticket dc doivent remonter le nom contenu dans le grand tableau a côté,
    en fonction de si c est "my eur" il ira chercher dans la ligne EBISA du grand tableau le nom de la banque dans la colone EUR (DEUTDEFF)
    si c'est "my USD" il ira dans la ligne EBISA mais cherche le nom dans la colone USD (CITIUS33)
    Donc pour "my+devise" il ira toujours dans la ligne EBISA cela dependra de la devise
    Dans le ticket page "REF" c est DEUTDEFF car c'est "my eur" donc il va dans la ligne EBISA colone EUR

    ' pour "their USD" il ira cherché le nom en fonction du nom de la contrepartie (=CLI page 2401) et la devise ( exemple si ecobank benin (cellule A27 page 2401) dans le petit tableau, est la counterparty et que c est "their USD" il ira chercher ds la colone USD de la ligne ecobank benin chercher le code (CITIUS33) pour l afficher
    ' donc cette boucle dans mon code n'est pas bien car elle se référe juste a 2 noms alors qu'elle doit copier dans le grand tableau dans la feuille "REF"

    voici la liste des charges

    et le code du module
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
     
    Option Explicit ' pour obliger a déclarer toutes tes variables
     
    Public i As Integer
    Public Nom As String
    Public MaFeuille As Worksheet
    Public message As String
    Public MaNewFeuille As Worksheet
     
    Public Sub CréatNoms()
     
    Dim débnoms As Range
    Dim listnoms As Range
     
     
    Set débnoms = Sheets(Sheets.Count).Range("A26")
     
    Set listnoms = Range(débnoms, débnoms.End(xlToRight))
     
    For Each débnoms In listnoms
        For i = 1 To 10
            ActiveWorkbook.Names.Add Name:=débnoms.Value & "_" & i, RefersToR1C1:=débnoms.Offset(i, 0)
        Next
    Next
     
    'Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     
        For i = 1 To 10
            If Selection = Range("D" & i) Then
            Selection = Range("A" & i, ActiveCell.Offset(0, 12))
            End If
        Next i
     
     
    End Sub
     
     
    Sub Transf_Data()
    '
    ' Transf_Data Macro
    '
    '
    '   Création nouvelle page avec le numèro du deal
     
    Set MaFeuille = Sheets(Sheets.Count)
     
    Nom = Sheets(Sheets.Count).Range("D27").Value
     
    'On vérifie que le nom n'existe pas déjà
    On Error Resume Next 'en cas d'erreur, on continue sans générer d'erreur
    Set MaNewFeuille = Sheets(Nom)
    On Error GoTo 0 'on réactive la gestion d'erreur
    'On vérifie si la variable a obtenu un objet ou non
    If Not MaNewFeuille Is Nothing Then message = MsgBox("Voulez vous ?", vbRetryCancel + vbQuestion, "Mon programme")     'Exit Sub ' Si elle existe déjà Msg soit annule ou remplace
     
     
    'Sinon on continu
    'Add retourne un objet Worksheet, que tu recupere dans MaNewFeuille
    Set MaNewFeuille = Sheets.Add(After:=Sheets(Sheets.Count))
     
    'Renome la nouvelle feuille
    MaNewFeuille.Name = Nom
     
     
     
    '   Création tab et mise en page
     
     
    Sheets("REF").Select
    Range("A1:E17").Select
        Selection.Copy
        Sheets(Nom).Select
        ActiveSheet.Paste
     
        Columns("B:B").ColumnWidth = 20.29
        Columns("C:C").ColumnWidth = 6.29
        Columns("D:D").ColumnWidth = 15.43
        Rows("3:3").Select
        Selection.RowHeight = 20.25
        Rows("4:4").Select
        Selection.RowHeight = 15.75
        Rows("5:5").Select
        Selection.RowHeight = 15.75
        Rows("6:6").Select
        Selection.RowHeight = 15.75
        Rows("7:7").Select
        Selection.RowHeight = 15.75
        Rows("8:8").Select
        Selection.RowHeight = 15.75
        Rows("9:9").Select
        Selection.RowHeight = 15.75
        Rows("10:10").Select
        Selection.RowHeight = 15.75
        Rows("11:11").Select
        Selection.RowHeight = 15.75
        Rows("12:12").Select
        Selection.RowHeight = 15.75
        Rows("13:13").Select
        Selection.RowHeight = 15.75
        Rows("14:14").Select
        Selection.RowHeight = 15.75
        Rows("15:15").Select
        Selection.RowHeight = 15.75
        Rows("16:16").Select
        Selection.RowHeight = 15.75
     
        Range("C4:D4").Select
        Selection.ClearContents
     
         Range("C6:D8").Select
        Selection.ClearContents
     
        Range("C10:D16").Select
        Selection.ClearContents
     
     
     
        Range("C13:D13").Select
        Selection.Font.Bold = False
        Selection.Font.Bold = True
        Selection.Font.Italic = False
        Selection.Font.Italic = True
     
     End Sub
     
     
    '   Déclarer variables à copier
     
    Sub varcop()
     
        Dim CLI As Range
     
        Dim REC As Range
     
        Dim PAY As Range
     
        Dim DS As Range
     
        Dim SF As Range
     
        Dim VD As Range
     
        Dim AMCCY1 As Range
     
        Dim AMCCY2 As Range
     
        Dim CCYO As Range
     
        Dim CCYT As Range
     
        Dim RATE As Range
     
     
     
    '  Dètermine destination variables ds "deal" worksheet
     
     For i = 1 To 10
     
        Set CLI = CLI & "_" & i = Sheets(Nom).Range("C6:D6")
     
        Set REC = REC & "_" & i = Sheets(Nom).Range("C14:D14")
     
     
        Set PAY = PAY & "_" & i = Sheets(Nom).Range("C15:D15")
     
     
        Set DS = DS & "_" & i = Sheets(Nom).Range("C4:D4")
     
     
        Set SF = SF & "_" & i = Sheets(Nom).Range("C7:D7")
     
     
        Set VD = VD & "_" & i = Sheets(Nom).Range("C8:D8")
     
     
        If Worksheets("2401").Range("G27").Value > 0 Then
        Set AMCCY1 = AMCCY1 & "_" & i = Sheets(Nom).Range("D11")
        Else
        Set AMCCY2 = AMCCY2 & "_" & i = Sheets(Nom).Range("D12")
        End If
     
     
        If Worksheets("2401").Range("H27").Value < 0 Then
        Set AMCCY2 = AMCCY2 & "_" & i = Sheets(Nom).Range("D12")
        Else
        Set AMCCY2 = AMCCY2 & "_" & i = Sheets(Nom).Range("D11")
        End If
     
        If Worksheets("2401").Range("G27").Value > 0 Then
        Set CCYO = CCYO & "_" & i = Sheets(Nom).Range("C11")
        Else
        Set CCYO = CCYO & "_" & i = Sheets(Nom).Range("C12")
        End If
     
        If Worksheets("2401").Range("H27").Value < 0 Then
        Set CCYT = CCYT & "_" & i = Sheets(Nom).Range("C12")
        Else
        Set CCYT = CCYT & "_" & i = Sheets(Nom).Range("C11")
        End If
     
        Set RATE = RATE & "_" & i = Sheets(Nom).Range("C13:D13")
     
       Next i
     
     
    '   Transfère PO data
     
     Dim intcount As Integer
        For intcount = 1 To 11
            For i = 1 To 10
                Select Case intcount
                Case 1: CLI = CLI & "_" & i = Range(CLI & "_" & i)
                Case 2: REC = REC & "_" & i = Range(REC & "_" & i)
                Case 3: PAY = PAY & "_" & i = Range(PAY & "_" & i)
                Case 4: DS = DS & "_" & i = Range(DS & "_" & i)
                Case 5: SF = SF & "_" & i = Range(SF & "_" & i)
                Case 6: VD = VD & "_" & i = Range(VD & "_" & i)
                Case 7: AMCCY1 = AMCCY1 & "_" & i = Range(AMCCY1 & "_" & i)
     
                        'AMCCY1 = AMCCY1 & "_" & i.NumberFormat = "0.0000"
     
                Case 8:  AMCCY2 = AMCCY2 & "_" & i = Range(AMCCY2 & "_" & i)
     
                         'AMCCY2 = AMCCY2 & "_" & i.NumberFormat = "0.0000"
     
                Case 9: CCYO = CCYO & "_" & i = Range(CCYO & "_" & i)
                Case 10: CCYT = CCYT & "_" & i = Range(CCYT & "_" & i)
                Case 11: RATE = RATE & "_" & i = Range(RATE & "_" & i)
            End Select
            Next i
        Next intcount
     
    End Sub
     
    Sub contpart()
     
    'Trouver la contrp
     
    Dim TheCell As Range
     
    'on recherche dans cet intervale de cellules si un mot existe
    'On va donc boucler sur chaque cellule et tester son contenu
    For Each TheCell In Worksheets(Nom).Range("C14:D15")
        'For va executer le code autant de fois que de cellule contenu dans l'interval C14:D14
        'A chaque execution TheCEll representera la cellule pointée par la boucle For
        '1ere execution thecell correspond a C14, 2eme execution TheCell correspond a D14
        '3eme execution TheCEll correspond a C15, 4eme execution TheCell correspond a D15
     
        'on regarde le contenu et on choisit ce que l'on doit mettre a la place en fonction de celui ci
        If TheCell.Value = "DEUT" Then
            'On change la valeur contenu dans TheCell
            TheCell.Value = "DEUTSCHE BANK FFT"
        ElseIf TheCell.Value = "CITINY" Then
            TheCell.Value = "CITIBANK NEW YORK"
        End If
    Next ' on retourne au For et TheCell reprèsente la cellule suivante
    End Sub
     
    Sub TypOpe()
     
    Dim Ope As Variant
    Dim today As Date
     
     
    Ope = Sheets(Sheets.Count).Range("F27")
     
    today = Date
     
        If Ope = today Then
            Sheets(Sheets.Count).Select
            Range("C7:D7") = "TODAY"
        End If
     
        If Ope = today + 1 Then
            Sheets(Sheets.Count).Select
            Range("C7:D7") = "TOM"
        End If
     
        If Ope = today + 2 Then
            Sheets(Sheets.Count).Select
            Range("C7:D7") = "SPOT"
        End If
     
        If Ope = today + 3 Then
            Sheets(Sheets.Count).Select
            Range("C7:D7") = "FORW"
        End If
     
    End Sub
     
     
    Sub transvalneg()
     
     
    Dim TheCel As Range
     
    For Each TheCel In Sheets(Sheets.Count).Range("D11: D12 ")
     
        If TheCel.Value < 0 Then
            TheCel.Value = TheCel * -1
        ElseIf TheCel.Value > 0 Then
            TheCel.Value = TheCel
        End If
    Next
    End Sub
    et pr la page this workbook
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
     
    Option Explicit
    Private Sub Workbook_Open()
     
    Call CréatNoms
     
    End Sub
     
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim listdon As Variant
    Dim lign As Byte
    Dim donexp As String
    With Target
            If .Column <> 4 Or .Row < 10 Then Exit Sub
            lign = .Row - 9
            listdon = Array("CLI", "REC", "PAY", "DS", "SF", "VD", "AMCCY1", "AMCCY2", "CCYO", "CCYT", "RATE")
            donexp = ""
            For Each donnée In listdon
                    donexp = donexp & Range(donnée & "_" & lign)
            Next donnée
            ActiveSheet.Range("M" & .Row).Value = donexp
    End With
     
    Call Transf_Data
    Call varcop
    Call contpart
    Call TypOpe
    Call transvalneg
     
    End Sub
    merci

  2. #2
    Expert confirmé
    Avatar de Qwazerty
    Homme Profil pro
    La très haute tension :D
    Inscrit en
    Avril 2002
    Messages
    4 122
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 45
    Localisation : France

    Informations professionnelles :
    Activité : La très haute tension :D
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2002
    Messages : 4 122
    Par défaut
    Salut
    http://www.developpez.net/forums/d10...e/#post5737520
    Tiens au moins compte des conseilles que les gens ont pris le temps de te donner....
    ++
    Qwaz

    MagicQwaz := Harry Potter la baguette en moins
    Le monde dans lequel on vit
    Ma page perso DVP
    Dernier et Seul Tutoriel : VBA & Internet Explorer
    Dernière contribution : Lien Tableau Structuré et UserForm
    L'utilisation de l’éditeur de message

  3. #3
    Membre confirmé
    Inscrit en
    Janvier 2011
    Messages
    97
    Détails du profil
    Informations forums :
    Inscription : Janvier 2011
    Messages : 97
    Par défaut
    je remercie d ailleurs tous ces gens .... j ai essayé d en tenir compte le plus possible

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Modification code Print
    Par zine pef dans le forum VB 6 et antérieur
    Réponses: 4
    Dernier message: 19/01/2010, 17h03
  2. Modifications code vb dans page asp net
    Par Crampignon dans le forum ASP.NET
    Réponses: 9
    Dernier message: 22/04/2009, 13h45
  3. TRAC modification code source
    Par bella1 dans le forum Applications et environnements graphiques
    Réponses: 3
    Dernier message: 06/08/2007, 11h18
  4. TRAC modification code source
    Par bella1 dans le forum Applications et environnements graphiques
    Réponses: 0
    Dernier message: 03/08/2007, 23h29
  5. Modification code ftp
    Par bebechat dans le forum C++
    Réponses: 3
    Dernier message: 05/04/2007, 14h30

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo