'Sur une idée originale de (c) ARMEL SIME NGONGANG, conception et réalisation 'Cette fonction permet de remplacer le texte d'une fonction par une autre. La fonction est récursive. 'Je l'ai écrite ce matin, afin de traduire les requêtes Access pour qu'elles soient comptable SQL Server, exemple des fonction IIF, ISNULL, ... mais l'utilisation peut être encore plus générale. 'Le but de cette fonction n'est pas de valider la conformité de l'expression mais juste, mais il s'agit d'un traitement de texte simpliste et assez cool. 'J'ai fait une mise à jour de la version précédente, qui était orientée pour mes besoins ponctuels celui de traduire du texte SQL Access vers SQL Server. Il peut également être utilisé intelligemment pour traduire du code. 'psText est le texte de départ, ou l'expression texte 'psFunctionName est le nom de la fonction 'psPattern est le masque de la function de destination, les paramètres sont indiqués dans le pattern, [%1] designe le paramètre1, [%2] le paramètre2, .... Public Function ConvertFunctionText(ByVal psText As String, _ ByVal psFunctionName As String, _ ByVal psPattern As String, _ Optional ByVal plStart As Long = -1, _ Optional ByVal psTextDelimiter As String = "'") As String Dim lPos As Long, lParentheses As Long, bTextOn As Boolean, sCar As String, lLenText As Long Dim lPos0 As Long, lPos1 As Long, lPos2 As Long, aParameters As Variant, i As Long, sPatternReplace As String, bFoundOK As Boolean 'Identifie "psTextDelimiter" à l'intérieur d'un texte psText = Replace(psText, psTextDelimiter & psTextDelimiter, Chr(1)) lLenText = Len(psText) 'Lit la function en partant de la droite vers la gauche lPos = InStrRev(psText, psFunctionName, plStart, vbTextCompare) If lPos <> 0 Then 'Recupère dans la variable lPos0, la position de la function dans le texte lPos0 = lPos lPos = lPos0 + Len(psFunctionName) 'Verifie qu'il s'agisse bien du début de texte de la function If lPos0 <> 1 Then If InStr(1, "+-*/\^&<>=(){}, ", Mid(psText, lPos0 - 1, 1)) <> 0 Then bFoundOK = True Else bFoundOK = True End If 'Si la function est trouvée, la suite devrait être "(" If bFoundOK Then Do While Mid(psText, lPos, 1) = " " lPos = lPos + 1 Loop bFoundOK = (Mid(psText, lPos, 1) = "(") End If If bFoundOK Then 'La function a bien été identifiée lParentheses = 0 lPos = lPos + 1 'Sauver dans lpos1, la position de debut des paramètres de la function lPos1 = lPos Do 'Lire le caractère sCar = Mid(psText, lPos, 1) If Not bTextOn Then Select Case sCar Case "(": 'Compter les parenthèses lParentheses = lParentheses + 1 Case ",": 'Si pas de parenthèse ouverte, alors il s'agit du séparateur de paramètre If lParentheses = 0 Then Mid(psText, lPos, 1) = Chr(2) Case psTextDelimiter: 'Il s'agit d'un debut de texte bTextOn = True Case ")": 'Si pas de parenthese ouverte, alors il s'agit de la fin des paramètres de la function If lParentheses = 0 Then sPatternReplace = psPattern 'Sauver dans lpos1, la position de fin des paramètres de la function lPos2 = lPos - 1 'Lire les paramètres de la function aParameters = Split(Mid(psText, lPos1, lPos2 - lPos1 + 1), Chr(2)) 'Remplacer dans le Pattern, les paramètres de la function de départ For i = LBound(aParameters) To UBound(aParameters) sPatternReplace = Replace(sPatternReplace, "[%" & i + 1 & "]", Trim(aParameters(i))) Next i Erase aParameters 'Recomposer l'expression de départ psText = Left(psText, lPos0 - 1) & sPatternReplace & Mid(psText, lPos2 + 2) 'Rechercher s'il existe la function dans le texte restant If lPos0 > 1 Then psText = ConvertFunctionText(psText, psFunctionName, psPattern, lPos0 - 1) Exit Do Else 'La parenthèse n'est pas ouverte alors décompter les parenthèses lParentheses = lParentheses - 1 End If Case Else: End Select ElseIf sCar = psTextDelimiter Then bTextOn = False End If lPos = lPos + 1 Loop While (lPos <= lLenText) ElseIf lPos0 > 1 Then 'La function a été identifiée mais avec une syntaxe incorrecte, il faut l'ignorer et poursuivre la recherche psText = ConvertFunctionText(psText, psFunctionName, psPattern, lPos0 - 1) End If End If psText = Replace(psText, Chr(1), psTextDelimiter & psTextDelimiter) ConvertFunctionText = psText End Function
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.