Amelioration du code VBA

Le 09/06/2022 à 15:37

BNJ FORUM

voici mon code vba qui appel une fonction dapres le client choisi, est ce qu'il ya une methode mieux que ca, et aussi je veux un message qui s'affiche tout en indiquant le nom du client

la valeur du clnt_dt a partir d'une drop down list sur un userform

Merci

Private Sub Import_Client_data_Click()
If Me.Clnt_dt.Value = "CLIENT7" Then
    Call get_file_CLIENT7
End If
If Me.Clnt_dt.Value = "CLIENT8" Then
    Call get_file_CLIENT8
End If
If Me.Clnt_dt.Value = "CLIENT9" Then
    Call get_file_CLIENT9
End If
If Me.Clnt_dt.Value = "CLIENT10" Then
    Call get_file_CLIENT10
End If
If Me.Clnt_dt.Value = "CLIENT11" Then
    Call get_file_CLIENT11
End If
If Me.Clnt_dt.Value = "CLIENT12" Then
    Call get_file_CLIENT12
End If
Call Pvt_tbl_rfrsh
MsgBox "Donnees de "CLIENT X" importé avec succes", vbInformation
End Sub
Le 09/06/2022 à 15:50

Hello

Tu peux utiliser Select Case, c'est plutôt simple

Select Case Me.Clnt_dt.Value
    Case "CLIENT7"
        call get_file_CLIENT7
    case "CLIENT8"
        call get_file_CLIENT8
    ...
    case "CLIENTN"
        call get_file_CLIENTN
End Select

MsgBox "Donnees de " & Me.Clnt_dt.Value & " importé avec succes", vbInformation
Le 09/06/2022 à 15:55

Ou alors tu montres la procédure get_file_client pour voir si on ne peut pas l'améliorer
par exemple en faisant :

call get_file(Me.Clnt_dt.Value)

les possibilités sont infinies, mais sans fichier pas simple de choisir

Le 09/06/2022 à 15:57

Bonjour Mc Charon, Ynss

Le select case réduit le nombre de lignes,

mais je pense que les fonctions get_file_CLIENTx peuvent être aussi factorisés, pour cela il nous faudrait un peu plus de lignes de code

Le 09/06/2022 à 16:04
Sub get_file_CLIENT8()
Range("A1357:N1476").ClearContents
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Import Data", fileFilter:="Excel file (*.xls*),*xls*")
If FileToOpen <> False Then
 Set OpenBook = Application.Workbooks.Open(FileToOpen)
 OpenBook.Sheets("CLIENT8").Range("B4").CurrentRegion.Copy
 ThisWorkbook.ActiveSheet.Range("A1356").PasteSpecial xlPasteValues
 Application.CutCopyMode = False
 OpenBook.Close False
 Else: MsgBox "Aucun fichier choisir", vbInformation
End If
 Application.ScreenUpdating = True
End Sub
Le 09/06/2022 à 16:08

on va encore chiant, mais avec le client 7 ou 9 ça donne quoi ?

Le 09/06/2022 à 16:15
Sub get_file_CLIENT7()
Range("A1111:N1230").ClearContents
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Import Data", fileFilter:="Excel file (*.xls*),*xls*")
If FileToOpen <> False Then
 Set OpenBook = Application.Workbooks.Open(FileToOpen)
 OpenBook.Sheets("CLIENT7").Range("B4").CurrentRegion.Copy
 ThisWorkbook.ActiveSheet.Range("A1110").PasteSpecial xlPasteValues
 Application.CutCopyMode = False
 OpenBook.Close False
 Else: MsgBox "Aucun fichier choisir", vbInformation
End If
 Application.ScreenUpdating = True
End Sub
-
Sub get_file_CLIENT8()
Range("A1234:N1353").ClearContents
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Import Data", fileFilter:="Excel file (*.xls*),*xls*")
If FileToOpen <> False Then
 Set OpenBook = Application.Workbooks.Open(FileToOpen)
 OpenBook.Sheets("CLIENT8").Range("B4").CurrentRegion.Copy
 ThisWorkbook.ActiveSheet.Range("A1233").PasteSpecial xlPasteValues
 Application.CutCopyMode = False
 OpenBook.Close False
 Else: MsgBox "Aucun fichier choisir", vbInformation
End If
 Application.ScreenUpdating = True
End Sub
Sub get_file_CLIENT9()
Range("A1357:N1476").ClearContents
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Import Data", fileFilter:="Excel file (*.xls*),*xls*")
If FileToOpen <> False Then
 Set OpenBook = Application.Workbooks.Open(FileToOpen)
 OpenBook.Sheets("CLIENT9").Range("B4").CurrentRegion.Copy
 ThisWorkbook.ActiveSheet.Range("A1356").PasteSpecial xlPasteValues
 Application.CutCopyMode = False
 OpenBook.Close False
 Else: MsgBox "Aucun fichier choisir", vbInformation
End If
 Application.ScreenUpdating = True
End Sub
Le 09/06/2022 à 16:33

OK j'ai presque un truc, mais il me manque un élément

Entre chaque client tu as un ecart de 123 ligne, donc on peut faire une fonction entre le client et son numéro de ligne iRow = 123 * iNum + ton origine
et iNum c'est une fonction qui permet d'attribuer ton client à un indice, mais sans info je ne peux rien faire

Sub get_file_CLIENT(sClientId)

    iNum = ? 'je ne sias pas commetn fonctionne les clients
    iRow = 123 * iNum + 3  'j'ai mis 3 dans le cas où tu commences ton tableau à partir de 3

    Range(cells(iRow+1,1),cells(iRow+120, 14)).ClearContents
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook

    Application.ScreenUpdating = False
    FileToOpen = Application.GetOpenFilename(Title:="Import Data", fileFilter:="Excel file (*.xls*),*xls*")

    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets(sClientId).Range("B4").CurrentRegion.Copy
        ThisWorkbook.ActiveSheet.Range(cells(iRow, 1)).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        OpenBook.Close False
    Else: MsgBox "Aucun fichier choisir", vbInformation
    End If
    Application.ScreenUpdating = True
End Sub
Le 09/06/2022 à 16:41

Bonjour le fil

@Mc Charon, perso je ferais plutôt 

Sub get_file_CLIENT(iNum as Integer)
    iRow = 123 * iNum + 3  'j'ai mis 3 dans le cas où tu commences ton tableau à partir de 3

    Range(cells(iRow+1,1),cells(iRow+120, 14)).ClearContents
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook

    Application.ScreenUpdating = False
    FileToOpen = Application.GetOpenFilename(Title:="Import Data", fileFilter:="Excel file (*.xls*),*xls*")

    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets("CLIENT" & inum).Range("B4").CurrentRegion.Copy
        ThisWorkbook.ActiveSheet.Range(cells(iRow, 1)).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        OpenBook.Close False
    Else: MsgBox "Aucun fichier choisir", vbInformation
    End If
    Application.ScreenUpdating = True
End Sub

Avec

If Me.Clnt_dt.Value = "CLIENT7" Then

Call get_file_CLIENT(7)

End If

A+

Le 09/06/2022 à 16:46

J'y ai pensais, mais je me suis dit le CLIENT7 c'est juste pour l'anonymat

J'avais ça sinon

iNum = Right(sClientId, len(sClientId) - inStr(1,sClientId,"T"))

et pour l'utilisation
Call get_file_CLIENT(me.Clnt_dt.value)

plus besion de If ou select case

Le 09/06/2022 à 17:06

Merci pour vos repenses tres interessant ,

et ui les noms des clients cest pas client 1 ....

alors cest possible que le macro marche avec des nouveaux clients que je viens de cree ?

Le 10/06/2022 à 10:20

Hello (again)

Du moment que le fichiers du client à le même nom que le client oui,
mais encore une fois sans plus d'info sur les noms difficile d'améliorer

il n'y a aucun moyen de partager le document ?

Le 12/06/2022 à 19:28

Rebonjour

12clientstest.xlsm (197.50 Ko)
Rechercher des sujets similaires à "amelioration code vba"