vba(excel)-vb

Question

voila g un prog en vba excel. je voudrai que cette macro soit executable en dehors de excel et donc la passer en vb avec une ihm.

voila le code si quelqun pourai m'aider
merci d'avance et a bientot
je voudrai savoir aussi comment faire pour ovrire excel via une form puis ouvrir un fichier particulier


Dim trouve As Boolean

Sub triDoublon()

Application.ScreenUpdating = False

Worksheets("TriSuppressionDoublon").Range("B7").Sort _
key1:=Worksheets("TriSuppressionDoublon").Range("B8"), _
Order1:=xlAscending, Header:=xlGuess

Set MaCell = Worksheets("TriSuppressionDoublon").Range("B7")

Do While Not IsEmpty(MaCell)

Set MaCellSuite = MaCell.Offset(1, 0)

If MaCellSuite.Value = MaCell.Value Then

MaCell.EntireRow.Delete

End If

Set MaCell = MaCellSuite

Loop

Sheets("TriSuppressionDoublon").Select

Range("B7:B65536").Select

Selection.Copy

Sheets("Workstations with SMS Installed").Select

Range("F7:F65536").Select

ActiveSheet.Paste

Dim celUn As Range

Dim celDeux As Range

Dim celTrois As Range

Set celUn = Worksheets("Workstations with SMS Installed").Range("A7")

Set celDeux = Worksheets("Workstations with SMS Installed").Range("D7")

Set celTrois = Worksheets("Workstations with SMS Installed").Range("F7")

'on  parcourt toutes les lignes

For i = 1 To Worksheets("Workstations with SMS Installed").Range("A7").CurrentRegion.Rows.Count - 1

    'si les trois cellules ne sont pas égales :

    'on recherche la présence du A dans D (s'il n'y est pas on supprime)

    'on recherche la présence du D dans A (s'il n'y est pas on ajoute)

    'si A = D alors on décale F d'une ligne
    If Not (celUn celDeux And celDeux celTrois) Then

        '*********************************************

        'recherche de A dans D

        'si A n'existe pas dans D --> suppression de A

        

        If celUn = celDeux And Not IsEmpty(celTrois) Then GoTo decaleF

        

        If rechercheA(celUn, celDeux) = False Then

            'on prend toutes les lignes jusqu'à la fin sur les 3 colonnes

            'et on les remonte d'une case

            fin = celUn.CurrentRegion.Rows.Count

            Range(celUn.Offset(1, 0).Address & ":" & celUn.Offset(fin, 2).Address).Select

            Selection.Cut

            celUn.Select

            Worksheets("Workstations with SMS Installed").Paste

            Set celUn = celDeux.Offset(0, -3)

            GoTo Suite

        End If

        '*********************************************

        '*********************************************

        'recherche de D dans A

        'si D n'existe pas dans A --> insertion de D

        If rechercheD(celUn, celDeux) = False Then

            'on décale A,B et C d'une ligne

            fin = celUn.CurrentRegion.Rows.Count

            Range(celUn.Address & ":" & celUn.Offset(fin, 2).Address).Select

            Selection.Cut

            celUn.Offset(1, 0).Select

            Worksheets("Workstations with SMS Installed").Paste

            Set celUn = celDeux.Offset(0, -3)

            'on insère le nouveau D

            celUn = celDeux.Value

            celUn.Offset(0, 1) = ""

            celUn.Offset(0, 2) = ""

            GoTo Suite

        End If

        '*********************************************

        

        'si A existe dans D et D existe dans A alors on décale F d'une ligne

decaleF:

        fin = celTrois.CurrentRegion.Rows.Count

        Range(celTrois.Address & ":" & celTrois.Offset(fin, 0).Address).Select

        Selection.Cut

        celTrois.Offset(1, 0).Select

        Worksheets("Workstations with SMS Installed").Paste

        Set celTrois = celUn.Offset(0, 5)

    Else
    '--------------SI A D F alors on recherche la Date ----------------'

        celUn.Offset(0, 2) = rechercheDate(celUn)

    '----------------------------------------------------------------------'

    End If

Set celUn = celUn.Offset(1, 0)

Set celDeux = celDeux.Offset(1, 0)

Set celTrois = celTrois.Offset(1, 0)

Suite:

Next i

Application.ScreenUpdating = True

End Sub

'******************Fonction de recherche de A dans D *****************'

Function rechercheA(ByVal celUnBis As Range, ByVal celDeuxBis As Range) As Boolean

Dim cherche As Boolean

cherche = False

For i = 1 To celDeuxBis.CurrentRegion.Rows.Count - 1
    If celUnBis celDeuxBis Then cherche True

    Set celDeuxBis = celDeuxBis.Offset(1, 0)

Next i
If (cherche) Then rechercheA True Else rechercheA False

End Function

'******************Fonction de recherche de D dans A *****************'

Function rechercheD(ByVal celUnBis As Range, ByVal celDeuxBis As Range) As Boolean

Dim cherche As Boolean

cherche = False

For i = 1 To celUnBis.CurrentRegion.Rows.Count - 1
    If celDeuxBis celUnBis Then cherche True

    Set celUnBis = celUnBis.Offset(1, 0)

Next i
If (cherche) Then rechercheD True Else rechercheD False

End Function

'******************Fonction de recherche de la date *****************'

Function rechercheDate(ByVal cel As Range) As String

Dim cherche As Boolean

cherche = False

Set celRecherche = Worksheets("TriSuppressionDoublon").Range("B7")

While Not IsEmpty(celRecherche) And cherche = False

    If celRecherche.Value = cel.Value Then

        cherche = True

        GoTo stopRecherche

    End If

    Set celRecherche = celRecherche.Offset(1, 0)

Wend

stopRecherche:

rechercheDate = celRecherche.Offset(0, -1).Value

End Function

Scalpweb · Answer

trop long ton code ! essayes d'être plus précis

Scalpweb www.PiceWCorp.net à partir du 1 Mai 2004 ! venez nombreux pour programmer gratuit !

nhervagault · Answer

Tu utilises la refernce dans vb a microsoft excel library 7 8 9 ... en fonction de ta version de excel

ensuite 

dim excel as new excel.application

apres 

tu prefixe tous tes objets excel avec 
excel

par exemple 

excel.application.save
excel.Worksheets

tu peux utiliser la syntaxe "with"

with excel
.Worksheets
. ...
end with

bonne prog

les objets excel doivent apparaitre dans l'observateur d'objet
et tu as la completion
ce qui ne fonctionne pas si tu utilises la fonction createobject

voila

Vba(excel)->vb

2 réponses

Discussions similaires