Transformer du "code Excel" en VBA, ça donnerait quoi ?

Version imprimable

02/03/2013, 16h13
Akhlan

Transformer du "code Excel" en VBA, ça donnerait quoi ?

Bonjour,

je reviens avec une autre question sur le même fichier (pour ceux qui suivent mes aventures trépidantes ^^)

Le fichier en question...
http://dl.free.fr/i7noV968J

Pour utiliser ce fichier, nous collons une ligne html (ligne 16 et 17 de l'onglet "Explications" comme exemple) sur la cellule A de l'onglet "Incidents mensuels". Ça complète automatiquement les colonnes A à E.

La cellule D requiert une intervention manuelle que je voudrais automatiser... Pour le moment, on glisse la cellule D du dessus pour appliquer la formule

Code:

=IF(LEFT(C2,4)="====",RIGHT(C2,LEN(C2)-(SEARCH("====",C2,5)+4)),C2)

Cette formule vérifie si l'alarme copiée en C (cellule cachée) commence par ==== et si tel est le cas, ne colle en D que le texte situé après le second ====. Si aucun ==== n'est détecté, la cellule C est copiée normalement en D

J'ai mis trop de "bout" de code chopé à droite et à gauche et du coup, je ne sais pas mettre ça en place....

De plus, question subsidiaire, je sais transformer une saisie en minuscule vers des majuscules mais je n'arrive pas à l'appliquer à la colonne D sans que des messages d'erreur apparaissent....

Je ne pense pas que ce soit bien compliqué pour une personne maîtrisant le VBA mais perso, je ne sais pas faire :-(

D'avance merci
Akhlan

Bonjour,

Si j'ai bien compris :

Code:

1
2
3
4
5
If Left([C2], 4) = "====" Then
    [D2] = UCase(Right([C2], Len([C2]) - (InStr(5, [C2], "====") + 4)))
Else
    [D2] = UCase([C2])
End If

02/03/2013, 17h11
Akhlan

Bonjour Daniel,

je ne crois pas que l'on se soit compris ;-)

on reçoit notre message au format html (exemple)

Code:

Incident 37 ====blablablablablablablablablabla==== Message 2Message 2Message 2 24/02/13 01:07:50 Serveur_2

et on colle les valeurs de ce message en cellule A38 de l'onglet "Incidents mensuels". La phrase "====blablablablablablablablablabla==== Message 2Message 2Message 2" se retrouve collée en cellule cachée C38 et on l'a met en forme en faisant glisser la cellule D37 sur la cellule D38 pour appliquer la formule

Code:

=IF(LEFT(C37,4)="====",RIGHT(C37,LEN(C37)-(SEARCH("====",C37,5)+4)),C37)

Ce que je veux c'est éviter cette manip en transformant ce code en VB pour faciliter la tâche de mes collègues...

L'histoire de majuscule était juste une question bonus et s’applique seulement à la colonne F qui me retourne une erreur si la valeur rentrée est en minuscule (mais ça pourra être vu plus tard...)
02/03/2013, 17h20
Philippe Tulliez

Bonjour Akhlan,
A part que c'est +3 au lieu de +4 le code VBA proposé par Daniel fait exactement ce que tu demandes me semble-t-il.
02/03/2013, 17h35
Akhlan

presque ;)

- Il ne faut pas que le texte soit mis en majuscule mais garde la casse de la colonne C
- Il faudrait que cela s'applique à la ligne où l'on colle le texte et non pas seulement à la ligne 2

Mais sinon, c'est bon, je pense avoir compris l'idée de base, je tente d'adapter ça à mon code ;)

Je reviens vous dire si j'y suis arrivé, merci ;)
02/03/2013, 17h46
Philippe Tulliez

Citation:

Envoyé par Akhlan

presque ;)
- Il ne faut pas que le texte soit mis en majuscule mais garde la casse de la colonne C

Si tu veux conserver la casse, il suffit de supprimer la fonction UCase( )

terminé...

Code:

1
2
3
4
5
6
    ligne = ActiveCell.Row
        If Left(Range("C" & ligne), 4) = "====" Then
            Range("D" & ligne) = (Right(Range("C" & ligne), Len(Range("C" & ligne)) - (InStr(5, Range("C" & ligne), "====") + 3)))
            Else
            Range("D" & ligne) = (Range("C" & ligne))
        End If

inclus dans

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
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Range("F2:F2500"), Target) Is Nothing Then
    ligne = ActiveCell.Row
        If Left(Range("C" & ligne), 4) = "====" Then
            Range("D" & ligne) = (Right(Range("C" & ligne), Len(Range("C" & ligne)) - (InStr(5, Range("C" & ligne), "====") + 3)))
            Else
            Range("D" & ligne) = (Range("C" & ligne))
        End If
   For Each col In Array(1, 2, 4, 5)
    If Not Target.Offset(, col).Comment Is Nothing Then Target.Offset(, col).Comment.Delete
    p = Application.Match(Target.Offset(, col), Application.Index([Dispo], , 1), 0)
    If Not IsError(p) Then
      temp = Sheets("Data").Range("Dispo").Cells(p, 2)
      Target.Offset(, col).AddComment
      Target.Offset(, col).Comment.Text Text:=temp
      Target.Offset(, col).Comment.Shape.TextFrame.AutoSize = True
    End If
   Next col
  End If
'---------------------------------------------------------------------------------------------------------------
'Ajoute une couleur aux serveurs rélatif à plusieurs applications
'---------------------------------------------------------------------------------------------------------------
 If Not Intersect([Liste_Serveurs], Target) Is Nothing Then
   On Error Resume Next
   Target.Interior.ColorIndex = [couleurs].Find(Target, LookAt:=xlWhole).Interior.ColorIndex
 End If
 
'---------------------------------------------------------------------------------------------------------------
' Ajoute la date et l'heure en colonne N
'---------------------------------------------------------------------------------------------------------------
    DateFR = CDate(Format(Date, "mm" & Chr$(47) & "dd" & Chr$(47) & "yy"))
    TimeFR = CDate(Format(Time, "hh" & Chr$(58) & "mm"))
    'If Target.Column <> 2 Then Exit Sub
    'If Target.Value <> "" And Cells(Target.Row, Target.Column + 13) = "" Then Cells(Target.Row, Target.Column + 13) = DateFR & " " & TimeFR
    If Cells(Target.Row, 14) <> "" And Cells(Target.Row, 15) <> "" And Cells(Target.Row, 16) = "" Then Cells(Target.Row, 16) = DateFR & " " & TimeFR
End Sub

Merci à vous deux

PS : Ne regardez pas le code en entier, ça ne doit pas être bien fait, c'est une imbrication de plusieurs code trouvé à droite et à gauche.... Mais dans l'ensemble, ça fonctionne ^^

Sur ma lancée, je retente de forcer la colonne F en majuscule et si ça ne fonctionne toujours pas, je reposterai...

02/03/2013, 18h16
Philippe Tulliez

Bonjour,
Comme indiqué plus haut, pour transformer une chaîne de caractères en majuscule, c'est la fonction UCase, pour les minuscules c'est LCase
Pour ton code et pour éviter des catastrophes lors de l'écriture, je te conseille vivement de préciser le classeur et la feuille où se trouve les cellules. Sinon, tu risques d'écrire dans la cellule de la feuille active au moment du lancement de la procédure.