Aide pour compléter un code Vba Excel

[Hpotter]

Bonjour à tous,

Le code ci-dessous me permet de remplir des feuilles de calcul se trouvant dans plusieurs fichiers en dehors du fichier "Maître" que j'ai appelé "Factures".

Ces feuilles sont recherchées selon les données se trouvant dans 2 Combo,
CmbListCred et CmbMarche.

CmbListCred est une saisie obligatoire donc pas de soucis particulier. Par contre, CmbMarche n'est pas obligatoire et c'est là que ça coince, si rien n'est saisi dans cette zone, toute la procédure plante.

Comment passer outre la partie grisée de mon code sans bloquer tout le reste ?

Merci par avance pour votre aide

Sub TestA()
Dim wbkRecap As Workbook, wbkBatiprix As Workbook
Dim shtFact As Worksheet, shtRecap As Worksheet, shtBati As Worksheet
Dim LastLigF As Long, LastLigR As Long
Dim stFichierComp As String, NumLig As String
Dim stFichComp As String, NumLign As String
Dim NewRec As Boolean, Exist As Boolean
Dim NewRech As Boolean, Existe As Boolean
 
Application.ScreenUpdating = False
Set shtFact = ThisWorkbook.Sheets("Engagements")
NumLig = Me.CmbListeCred.Value
NumLign = Me.CmbMarche.Value
stFichierComp = "S:\FACTURES\FACTURES 2011\Recap prest.xls"
stFichComp = "S:\FACTURES\FACTURES 2011\Batiprix.xls"
NewRec = False
NewRech = False

[COLOR="Red"][B]‘Ici on recherche le fichier « Recap prest.xls
‘Si le fichier n’existe pas on le créé[/B][/COLOR]
If Dir(stFichierComp) = ""    Workbooks.Add (1)
    NewRec = True
    Set wbkRecap = ActiveWorkbook

[COLOR="red"][B]'On nomme la première feuille[/B][/COLOR]
    Set shtRecap = wbkRecap.ActiveSheet
        shtRecap.Name = "L" & NumLig
        wbkRecap.SaveAs Filename:=stFichierComp
Else
[COLOR="red"][B]‘Si le fichier « recap prest.xls existe[/B][/COLOR]
    Set wbkRecap = Workbooks.Open(stFichierComp)
        Exist = False
    For Each ws In Worksheets
        If ws.Name = "L" & NumLig Then 
[COLOR="red"][B]‘On recherche la feuille correspondant à Me.CmbListeCred.Value[/B][/COLOR]                             
            Set shtRecap = ws
            Exist = True
            Exit For
        End If
    Next ws
    If Not Exist Then
[COLOR="red"][B]‘Si elle n’existe pas on la créée[/B][/COLOR]
        Set shtRecap = wbkRecap.Sheets.Add(Type:=xlWorksheet)        
shtRecap.Name = "L" & NumLig
        NewRec = True
    End If
End If

[COLOR="red"][B]‘Si le fichier « Batiprix.xls » n’existe pas, on le créé[/B][/COLOR]
[B]If Dir(stFichComp) = "" Then                                     
    Workbooks.Add (1)
    NewRech = True[/B]

[COLOR="red"][B]‘On nomme la première feuille[/B][/COLOR]
    [B]Set wbkBatiprix = ActiveWorkbook                                   
    Set shtBati = wbkBatiprix.ActiveSheet
        shtBati.Name = NumLign
        wbkBatiprix.SaveAs Filename:=stFichComp
Else[/B]
[/B][/B][/B][COLOR="red"][B]‘Si le fichier existe[/B][/COLOR]
    [B]Set wbkBatiprix = Workbooks.Open(stFichComp)                    
        Existe = False
    For Each wst In Worksheets
            If wst.Name = NumLign Then[/B]

[COLOR="red"][B]‘On recherche la feuille correspondant à Me.CmbMarche.Value [/B][/COLOR]
    [B]Set shtBati = wst
            Existe = True
            Exit For
        End If
    Next wst
    If Not Existe Then[/B]
[COLOR="red"][B]'Sinon on ajoute une nouvelle feuille[/B][/COLOR]
        [B]Set shtBati = wbkBatiprix.Sheets.Add(Type:=xlWorksheet) 
        shtBati.Name = NumLign
        NewRech = True
    End If
End If[/B]
[COLOR="red"][B]‘On recopie les données du fichier « Factures.xls » dans chaque feuille affichée de chaque fichier ouvert.[/B][/COLOR]
'-------------------------------------------------------
[B]With shtBati
    If NewRech Then
        .Range("A3").Value = "N° Engagement"
        .Range("B3").Value = "N° Devis"
        .Range("C3").Value = "Date"
        .Range("D3").Value = "Montant"
        .Range("E3").Value = "Site"
        .Range("F3").Value = "Objet"
    End If 

   
    LastLigR = .Range("A65536").End(xlUp).Row + 1
    
    .Range("A" & LastLigR).Value = shtFact.Range("D" & LastLigF).Value
    .Range("B" & LastLigR).Value = shtFact.Range("E" & LastLigF).Value
    .Range("C" & LastLigR).Value = shtFact.Range("F" & LastLigF).Value
    .Range("D" & LastLigR).Value = shtFact.Range("K" & LastLigF).Value
    .Range("E" & LastLigR).Value = shtFact.Range("I" & LastLigF).Value
    .Range("F" & LastLigR).Value = shtFact.Range("J" & LastLigF).Value
End With
wbkBatiprix.Close savechanges:=True[/B]

'-------------------------------------------------------

With shtFact   
    LastLigF = .Range("A65536").End(xlUp).Row + 1
    .Range("A" & LastLigF).Value = LastLigF - 5
    .Range("B" & LastLigF).Value = Me.TxtDate.Value
    .Range("B" & LastLigF).Value = Format(Me.TxtDate, "mm-dd-yyyy")
    .Range("C" & LastLigF).Value = NumLig
    .Range("D" & LastLigF).Value = Me.TxtNum.Value
    .Range("E" & LastLigF).Value = Me.TxtNumDev.Value
    .Range("F" & LastLigF).Value = Me.TxtDevis.Value
    .Range("F" & LastLigF).Value = Format(Me.TxtDevis, "mm-dd-yyyy")
    .Range("G" & LastLigF).Value = Me.CmbListeTiers.Value
    .Range("I" & LastLigF).Value = Me.CmbListeBat.Value
    .Range("J" & LastLigF).Value = Me.TxtObjet.Value
    .Range("K" & LastLigF).Value = Me.TxtMontant.Value
    .Range("M" & LastLigF).Value = Me.CmbNom.Value
    .Range("N" & LastLigF).Value = Me.CmbMarche.Value
    .Range("L" & LastLigF).Value = Me.TxtNome.Value
End With
'---------------------------------------------------------
With shtRecap
    If NewRec Then
        .Range("B3").Value = "Engagement"
        .Range("C3").Value = "Bâtiment"
        .Range("D3").Value = "Travaux réalisés"
        .Range("E3").Value = "Par"
        .Range("F3").Value = "Libellé"
        .Range("G3").Value = "Montant"
    End If
    
    LastLigR = .Range("B65536").End(xlUp).Row + 1
    
    .Range("B" & LastLigR).Value = shtFact.Range("D" & LastLigF).Value
    .Range("C" & LastLigR).Value = shtFact.Range("I" & LastLigF).Value
    .Range("D" & LastLigR).Value = shtFact.Range("J" & LastLigF).Value
    .Range("E" & LastLigR).Value = shtFact.Range("G" & LastLigF).Value
    .Range("G" & LastLigR).Value = shtFact.Range("K" & LastLigF).Value
End With

'---------------------------------------------------------

wbkRecap.Close savechanges:=True

Load UFengt
For i = 1 To 4
    With Sheets("BC" & i)
        .Range("B24").Value = Me.CmbListeBat.Value
        .Range("B25").Value = Me.CmbNom.Value
        .Range("D24").Value = Me.CmbNom.Value
        .Range("G6").Value = CDate(Me.TxtDate)
        .Range("H14").Value = Me.CmbListeCred.Value
        .Range("N11").Value = Me.CmbListeTiers.Value
        .Range("N15").Value = Me.TxtNum.Value
        .Range("N17").Value = Me.CmbMarche.Value
        .Range("N19").Value = Me.TxtNome.Value
    End With
Next i
    With Sheets("Ret")
        .Range("C6").Value = Me.TxtNum.Value
        .Range("C8").Value = Me.CmbNom.Value
        .Range("C10").Value = CDate(Me.TxtDate)
        .Range("C12").Value = Me.CmbListeBat.Value
        .Range("C14").Value = Me.TxtObjet.Value
        .Range("C17").Value = Me.CmbListeCred.Value
        .Range("C19").Value = Me.CmbListeTiers.Value
        .Range("C25").Value = Me.CmbMarche.Value
        .Range("C27").Value = Me.TxtNome.Value
        .Range("C29").Value = Me.TxtMontant.Value
        .Range("D4").Value = Me.TnumInc.Value
    .PageSetup.PrintArea = "$A$1:$G$44"
    .Visible = True
        .Visible = False
End With

Set shtFact = Nothing
Set shtRecap = Nothing
Set wbkRecap = Nothing
 
Application.ScreenUpdating = True
 
End Sub

 

[job75]

Re : Aide pour compléter un code Vba Excel

Bonjour Hpotter,

ce n'est pas en faisant la lecture à un âne qu'il deviendra intelligent

Essayez de lui apprendre à lire, on ne sait jamais

Quant à votre problème, croyez-vous que ça intéresse beaucoup de gens de se coltiner un code de 170 lignes

Un petit fichier (allégé) serait le bienvenu, une fois de plus ! Edit : Format Excel 2003 .xls de préférence.

A+

 

[Hpotter]

Re : Aide pour compléter un code Vba Excel

Bonjour,

Il m'est impossible de fournir un fichier allégé. J'ai mis le code complet car il est difficile d'expliquer toute la procédure.
Je pensais être clair, mais je me suis trompé. Je n'ai pas d'autres solutions à proposer.
Désolé

 

[Staple1600]

Re : Aide pour compléter un code Vba Excel

Bonsoir

Je pensais être clair, mais je me suis trompé. Je n'ai pas d'autres solutions à proposer.
Désolé

Et pourquoi cela est impossible

Tu ouvres Excel, tu fais CTRL+N
Toujours dans Excel,, tu ouvres ton fichier "de l'Impossible"
La tu fais ALT+F11
Tu copies/colles les différents code VBA dans le nouveau classeur
Tu renommes les feuilles du nouveau classeur pour qu'elles coïncident avec le code VBA.
Puis tu copie tes entêtes de colonnes dans ce nouveau classeur
Ensuite dans les pages de cellules concernées par le code VBA
Tu saisis =ALEA() tu recopies autant que nécessaire.
Enfin tu copies/colles -> Valeurs seules
Tu enregistres ce nouveau classeur sur ton bureau
Tu fermes Excel
Tu vas sur le bureau
Tu cliques droit sur ton nouveau classeur -> Envoyer vers Dossiers compressés.

Et tu joins ce zip dans ton premier message en l'éditant

Là, voyant que tu as mis la main à la patte, je pense que nous serons plusieurs à essayer de t'aider.

Mais on ne va surement pas (enfin j'espère) créer un fichier exemple à ta place !

Sur ce , je vais manger ma soupe en attendant ta PJ.

PS: Le vrai Harry Potter n'aurait point abandonné si vite

 

[Hpotter]

Re : Aide pour compléter un code Vba Excel

Mon fichier contient plus de 70 pages avec des dizaines de lignes de codes, sans compter les différents UserForm.

J'ai plus vite fait à modifier le code existant qu'à faire ce que tu me dis.

Si j'étais le vrai Harry Potter il m'aurait suffit d'un coup de baguette magique et j'aurai gagné du temps, et du temps je n'en ai pas.

Alors je vais me débrouiller autrement.

Merci toutefois pour votre aide à tous

 

[Staple1600]

Re : Aide pour compléter un code Vba Excel

Re


Tu vas me faire manger ma soupe froide

Il restait aussi la solution de cijoint.fr

Mais puisque tu vas te débrouiller autrement, je vais finalement pouvoir la manger chaude.


EDITION: je plussoie à vos propos Monsieur Job , et je vous salue et pour finir je vous souhaite bon appétit au cas ou

 

[Robert]

Re : Aide pour compléter un code Vba Excel

Bonsoir le fil, bonsoir le forum,

Hpotter, d'accord tant avec Job qu'avec Jean-Marie. Ton code plante et pour que l'on puisse t'aider il suffisait d'une structure similaire (deux ou trois onglets maxi) et du code qui plante. Mais pour cela il faudrait faire un petit effort (moindre certainement que le temps passé par Jean-Marie à t'expliquer comment procéder) et visiblement ça, ça t'est impossible... Finalement c'est ton problème, pas le notre !

 

[Hpotter]

Re : Aide pour compléter un code Vba Excel

Bonjour Robert,

Désolé pour ma réponse tardive. Comme je l'ai déjà expliqué, je ne peux pas dissosciés certaine feuille de mon fichier toutes étant liées. Derrière, plusieurs fichiers sont également liés au fichier maître.
Cela peut paraître "incroyable", mais tout n'est pas forcément aussi facile que l'on peu prétendre.

De toute façon, mon problème est réglé, j'ai trouvé quelques pistes dans mes livres et ainsi résolu mon soucis.

Bien amicalement à vous tous