Demande avis code vba vers XLD

[Sylvain]

Bonsoir,

suite à mon dernier post :
<http://www.excel-downloads.com/html/French/forum/read.php?f=1&i=144584&t=143506>
J'ai décidé de persévérer et m'inspirant de tout ce que j'ai trouvé, j'ai créé ce petit utilitaire.

Il marche comme suit :

vous copiez du code dans l'éditeur VB.
vous le collez sur une feuille de calcul.
vous appuyez sur le bouton VBA->XLD
le code est maintenant pourvu des balises pour le coller dans votre post

Les mots clefs sont en gras, les commentaires en itallique et l'indentation est respectée.

C'est pas parfait, mais qu'en pensez-vous ?


A+

 

[@+Thierry]

Bonjour Sylvain, le Forum

Je teste...


Option Explicit

Public Sub Creer_Bouton()
Dim CBb As CommandBarButton
    On Error Resume Next
    Set CBb = Application.CommandBars("Standard").Controls("vb_to_xld")
    On Error GoTo 0
    If Not CBb Is Nothing Then Exit Sub
    With Application.CommandBars("Standard").Controls.Add(msoControlButton)
        .Caption = "VBA->XLD"
        .TooltipText = "Mise en forme de code pour le forum XLD"
        .OnAction = "vb_to_xld"
        .FaceId = 1352
        .Style = msoButtonIconAndCaption
        .BeginGroup = True
    End With
End Sub
Public Sub Supprimer_Bouton()
    On Error Resume Next
    Application.CommandBars("Standard").Controls("VBA->XLD").Delete
    On Error GoTo 0
End Sub

Sub vb_to_xld()
Dim cell_code As Range
Dim cellule As Range
Dim trouve_commentaire
For Each cell_code In Selection
   'indentation
    cell_code.Value = Replace(cell_code.Value, "  ", Chr(160) & Chr(160))
    'commentaires
    cell_code.Value = Replace(cell_code.Value, "'", "'")
    trouve_commentaire = 0
    On Error Resume Next
    trouve_commentaire = Application.WorksheetFunction.Find("'", cell_code.Value)
    If trouve_commentaire > 0 Then 'un commentaire sur la ligne
      cell_code.Value = cell_code.Value & ""
    End If
    cell_code.Value = ligne1(cell_code.Value & "  ")
Next
Selection.Copy
End Sub
Function ligne1(ligne As String) As String
ligne = Replace(ligne, "Procedure ", "Procedure ")
ligne = Replace(ligne, "Preserve ", "Preserve ")
ligne = Replace(ligne, "Property ", "Property ")
ligne = Replace(ligne, "Nothing ", "Nothing ")
ligne = Replace(ligne, "StrComp ", "StrComp ")
ligne = Replace(ligne, "Assert ", "Assert ")
ligne = Replace(ligne, "ElseIf ", "ElseIf ")
ligne = Replace(ligne, "LBound ", "LBound ")
ligne = Replace(ligne, "Resume ", "Resume ")
ligne = Replace(ligne, "Select ", "Select ")
ligne = Replace(ligne, "Static ", "Static ")
ligne = Replace(ligne, "TypeOf ", "TypeOf ")
ligne = Replace(ligne, "UBound ", "UBound ")
ligne = Replace(ligne, "Output ", "Output ")
ligne = Replace(ligne, "Random ", "Random ")
ligne = Replace(ligne, "Append ", "Append ")
ligne = Replace(ligne, "Binary ", "Binary ")
ligne = Replace(ligne, "Access ", "Access ")
ligne = Replace(ligne, "Shared ", "Shared ")
ligne = Replace(ligne, "CVErr ", "CVErr ")
ligne = Replace(ligne, "CBool ", "CBool ")
ligne = Replace(ligne, "CByte ", "CByte ")
ligne = Replace(ligne, "CDate ", "CDate ")
ligne = Replace(ligne, "Debug ", "Debug ")
ligne = Replace(ligne, "Error ", "Error ")
ligne = Replace(ligne, "Print ", "Print ")
ligne = Replace(ligne, "ReDim ", "ReDim ")
ligne = Replace(ligne, "Until ", "Until ")
ligne = Replace(ligne, "While ", "While ")
ligne = Replace(ligne, "Input ", "Input ")
ligne = Replace(ligne, "Close ", "Close ")
ligne = Replace(ligne, "Write ", "Write ")
ligne = Replace(ligne, "With ", "With ")
ligne = Replace(ligne, "Exit ", "Exit ")
ligne = Replace(ligne, "Each ", "Each ")
ligne = Replace(ligne, "Case ", "Case ")
ligne = Replace(ligne, "CCur ", "CCur ")
ligne = Replace(ligne, "CDbl ", "CDbl ")
ligne = Replace(ligne, "CDec ", "CDec ")
ligne = Replace(ligne, "CInt ", "CInt ")
ligne = Replace(ligne, "CLng ", "CLng ")
ligne = Replace(ligne, "CSng ", "CSng ")
ligne = Replace(ligne, "CStr ", "CStr ")
ligne = Replace(ligne, "CVar ", "CVar ")
ligne = Replace(ligne, "Else ", "Else ")
ligne = Replace(ligne, "GoTo ", "GoTo ")
ligne = Replace(ligne, "Like ", "Like ")
ligne = Replace(ligne, "Loop ", "Loop ")
ligne = Replace(ligne, "Step ", "Step ")
ligne = Replace(ligne, "Then ", "Then ")
ligne = Replace(ligne, "Wend ", "Wend ")
ligne = Replace(ligne, "Open ", "Open ")
ligne = Replace(ligne, "Lock ", "Lock ")
ligne = Replace(ligne, "Read ", "Read ")
ligne = Replace(ligne, "Call ", "Call ")
ligne = Replace(ligne, "End ", "End ")
ligne = Replace(ligne, "For ", "For ")
ligne = Replace(ligne, "Get ", "Get ")
ligne = Replace(ligne, "Let ", "Let ")
ligne = Replace(ligne, "Set ", "Set ")
ligne = Replace(ligne, "Sub ", "Sub ")
ligne = Replace(ligne, "If ", "If ")
ligne = Replace(ligne, "Is ", "Is ")
ligne = Replace(ligne, "To ", "To ")
ligne = Replace(ligne, "On ", "On ")
ligne = Replace(ligne, "Do ", "Do ")
ligne = Replace(ligne, "In ", "In ")
ligne = Replace(ligne, "Or ", "Or ")
ligne = Replace(ligne, "WithEvents ", "WithEvents ")
ligne = Replace(ligne, "Currency ", "Currency ")
ligne = Replace(ligne, "Explicit ", "Explicit ")
ligne = Replace(ligne, "Function ", "Function ")
ligne = Replace(ligne, "Optional ", "Optional ")
ligne = Replace(ligne, "Boolean ", "Boolean ")
ligne = Replace(ligne, "Compare ", "Compare ")
ligne = Replace(ligne, "Declare ", "Declare ")
ligne = Replace(ligne, "Integer ", "Integer ")
ligne = Replace(ligne, "Private ", "Private ")
ligne = Replace(ligne, "Variant ", "Variant ")
ligne = Replace(ligne, "Double ", "Double ")
ligne = Replace(ligne, "Module ", "Module ")
ligne = Replace(ligne, "Object ", "Object ")
ligne = Replace(ligne, "Option ", "Option ")
ligne = Replace(ligne, "Public ", "Public ")
ligne = Replace(ligne, "Single ", "Single ")
ligne = Replace(ligne, "String ", "String ")
ligne = Replace(ligne, "ByRef ", "ByRef ")
ligne = Replace(ligne, "ByVal ", "ByVal ")
ligne = Replace(ligne, "Const ", "Const ")
ligne = Replace(ligne, "Empty ", "Empty ")
ligne = Replace(ligne, "False ", "False ")
ligne = Replace(ligne, "Type ", "Type ")
ligne = Replace(ligne, "Base ", "Base ")
ligne = Replace(ligne, "Byte ", "Byte ")
ligne = Replace(ligne, "Date ", "Date ")
ligne = Replace(ligne, "Long ", "Long ")
ligne = Replace(ligne, "Enum ", "Enum ")
ligne = Replace(ligne, "Next ", "Next ")
ligne = Replace(ligne, "Null ", "Null ")
ligne = Replace(ligne, "Text ", "Text ")
ligne = Replace(ligne, "True ", "True ")
ligne = Replace(ligne, "Dim ", "Dim ")
ligne = Replace(ligne, "Lib ", "Lib ")
ligne = Replace(ligne, "New ", "New ")
ligne = Replace(ligne, "As ", "As ")
ligne = Replace(ligne, "Not ", "Not ")

ligne1 = ligne
End Function


Je reviens voir...
@+Thierry

 

[@+Thierry]

Bravo Sylvain !!

Pas mal du tout, on dirait que l'italic n'est pas rétabli à partir de :

=> cell_code.Value = Replace(cell_code.Value, "'", "'")

Comme si le guillement est lui même pris en compte, mais c'est vrai que logiquement dans un code normal on aura pas ceci

Donc test concluant, bravo et bonne soirée
@+Thierry

 

[Jean-Marie]

Bonsoir Sylvain

Bon Sylvain, j'ai remplacer tous les Replace par WorksheetFunction.Substitute, pour que ton code fonctionne sur Mac. La traduction fonctionne dans la feuille d'Excel, maintenant il faut voir sur le forum. Go

Si cela fonctionne, c'est Génial, déjà dans la zone de saisie du post, il y a les bornes pour passer en gras, la seule inconnue c'est l'indentation.

@+Jean-Marie

Public Sub Cumul()
Dim vDate As Date
Dim vOp As String
Dim Cumul As Range
Dim I, J, K As Byte
Dim L, M, N As Byte
Dim FinCol As Byte
Dim FinLig As Byte
Dim ModeCal As Integer
Dim LigHis As Long

Application.ScreenUpdating = False
ModeCal = Application.Calculation
Application.Calculation = xlCalculationManual

FinCol = [IA7].End(xlToLeft).Column - 6
FinLig = [Tab].Rows.Count

For I = 1 To FinLig
†† If [B3].Offset(I, 0) <> "" Then
††††††Set Cumul = Range([B3].Offset(I, 0))
††††††For L = 1 To FinCol
†††††††† Cumul.Offset([DV].Offset(0, L), [H2]) = [F3].Offset(I, L) + Cumul.Offset([DV].Offset(0, L), [H2])
†††††††† Cumul.Offset([DV].Offset(0, L), 54 + [MoisImput].Offset(0, L)) = [F3].Offset(I, L) + Cumul.Offset([DV].Offset(0, L), 54 + [MoisImput].Offset(0, L))
††††††Next L
†† End If
Next I

ActiveSheet.Unprotect
[G4:HZ31].Select
Selection.SpecialCells(xlCellTypeConstants, 23).Select
Selection.ClearContents
[G4].Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Application.Calculation = ModeCal

Application.ScreenUpdating = True
End Sub

 

[Jean-Marie]

Re...

Sylvain, si tu as une idée pour l'indentation pour le mac, je suis preneur.

C'est déjà bien. Bonne soirée

@+Jean-Marie

 

[Jean-Marie]

Re...

Avec ces petits utilitaires que vous nous faites Messieurs pour nous facilité la vie sur XLD et pour notre plus grand plaisir. David va devoir créer une catégorie rien que pour vous.

@+Jean-Marie

 

[@+Thierry]

Bonsoir Jean Marie, re Sylvain

essaie ceci Jean Marie, je sais que le NBSP (Non Breakable Space) ne va pas passer alors je mets des des underscores volontaires (à supprimer)

Remplacer ceci
'indentation
cell_code.Value = Replace(cell_code.Value, " ", Chr(160) & Chr(160))


Par ceci
'indentation
cell_code.Value = WorksheetFunction.Substitute(cell_code.Value, " ", "&_n_b_s_p_;_"&_n_b_s_p_


Si ça peut passer sous Mac....

Tiens nous au courant...
@+Thierry

 

[@+Thierry]

oups un " mal placé

cell_code.Value = WorksheetFunction.Substitute(cell_code.Value, " ", "&_n_b_s_p_;_&_n_b_s_p_;")

@+Thierry

 

[Ti]

excusez-moi de m'immiscer dans ce post, mais cela me donne l'occasion de saluer la performance de Véri qui a mis directement la possibilité de garder la mise en forme de macros dans les posts par un simple tag sur Vériti.

Bon, tout ceci pour dire que comme c'est du PHP, David pourrait peut-être implémenter cette possibilité ici (comme on peut mettre un texte en italiques, on pourrait mettre une macro formatée directement). Ce serait tout de même plus simple, non ? Qu'en penses-tu David ? En tout cas moi qui suis maniaque quant à la présentation de mes macros, ça me plairait bien.

 

[Sylvain]

Bonsoir,

merci pour vos commentaires, en fait j'ai commencé ce travail car sur xld la couleur ne passait pas.

Je mets maintenant en ligne une version améliorée (pour ne pas mettre en gras des moitiés de mot).

J'ai essayé l'astuce de @+Thierry et les commentaires de Jean-Marie pour que ça marche sur Mac.

A+