code pour 2 feuilles dans 2 boutons différents?????

grisan29

grisan29

XLDnaute Accro
bonjour a vous tous

dans mon fichier de facturation , je viens de créer une feuille devis car avant il me suffisait de changer l'entête, donc comment peut 'on faire pour qu'un même code fonctionne avec 2 boutons dont un sur la feuille facture et l'autre sur la feuille devis, j'ai fait cela car je pense que ce sera plus facile par ce biais de créer une facture sur devis en incluant ce code dans la feuille devis
Code: 
Sub Créer_La_Facture()
Dim Sh As Worksheet, Trouve As Range
Feuil1.Copy
Set Sh = ActiveSheet
Sh.Name = "Facture " & Sh.Range("G1").Value
Sh.Range("D1") = "FACTURE  n°"
With Sh
   With .Range("A:A")
       Set Trouve = .Find(What:="Arrêtée Somme", LookIn:=xlValues, _
           LookAt:=xlPart, MatchCase:=False, SearchDirection:=xlNext)
       If Not Trouve Is Nothing Then
           Trouve.Offset(1).Resize(20, 2).Delete (xlUp)
       End If
   End With
End With
End Sub
code qui est incomplet mais fonctionnel
voici le code qui ajoute les articles dans la feuille "facture" et qui serais a modifier pour les 2 boutons
Code: 
Private Sub ajout_Click()
'*** bouton "ajout sur devis/facture"

  Dim lig As Integer, i As Integer
  Dim Sh As Worksheet, VPB As PageSetup
  Dim LargeurCol As Single, MaHauteur As Single, Lg_Origine As Single
  'calcul de la valeur de la variable lig
  Dim Mot As String
  Dim ctrMt, ctrTVA7, ctrTVA19 As Variant
  With Sheets("facture")
    '.Range("c18:M18,O18:P18").Borders(xlEdgeBottom).LineStyle = xlContinuous
    lig = .Range("B65536").End(xlUp)(2).Row
    If lig < 19 Then lig = 19


    'insertion d'une ligne
    .Rows(lig + 1).Insert

    If Not Me.TextBox2 = "" Then
      .Rows(lig) = ""
      .Range("D" & lig) = TextBox2.Value
      Lg_Origine = .Columns(3).ColumnWidth
      LargeurCol = .Columns(3).ColumnWidth + .Columns(4).ColumnWidth + .Columns(5).ColumnWidth + .Columns(6).ColumnWidth + _
                   .Columns(7).ColumnWidth + .Columns(8).ColumnWidth
      .Columns(4).ColumnWidth = LargeurCol
      With .Range("D" & lig, "H" & lig)
        .Font.Size = 14
        .Font.Name = "arial"
        .MergeCells = False
        .WrapText = True  'retour du texte à la ligne
        .EntireRow.AutoFit  'mettre la ligne en ajustement auto de la hauteur
        MaHauteur = .RowHeight  'voir quelle est la hauteur de la ligne une fois cet autofit fait
        .MergeCells = True  'refusionner

        '.VerticalAlignment = xlCenter
        .RowHeight = IIf(MaHauteur > 15, MaHauteur, 15)  'si la hauteur une fois autofit fait est inferieur à 15 je laisse 15 en minimum sinon hauteur de l'autofit (perso c'est la hauteur mini que je voulais
      End With
    End If
    .Columns(4).ColumnWidth = Lg_Origine
    DoEvents
    'recopie et mise en forme des données dans la feuille facturation
    .Cells(lig, "B") = Me.TextBox1
    .Cells(lig, "D") = Me.TextBox2
    .Cells(lig, "D").Font.Bold = False
    '.Cells(lig, "D").HorizontalAlignment = xlLeft
    '.Cells(lig, "D").VerticalAlignment = xlCenter
    .Range("D" & lig & ":H" & lig).Merge
    .Cells(lig, "I") = Me.TextBox3
    .Cells(lig, "I").NumberFormat = "#,##0.00€"
    .Cells(lig, "J") = Me.TextBox4
    .Cells(lig, "K") = Me.TextBox9
    .Cells(lig, "M") = Abs(Me.OptionButton2) + 1


    'calcul du montant HT
    If IsNumeric(.Cells(lig, "I")) And IsNumeric(.Cells(lig, "K")) Then
      .Cells(lig, "O").FormulaR1C1 = "=IF(RC[-2]=1,RC[-6]*RC[-4]*0.07,"""")"
      .Cells(lig, "O").NumberFormat = "#,##0.00€"
      .Cells(lig, "P").FormulaR1C1 = "=IF(RC[-3]=2,RC[-7]*RC[-5]*0.196,"""")"
      .Cells(lig, "P").NumberFormat = "#,##0.00€"
      .Cells(lig, "L").FormulaR1C1 = "=RC[-1]*RC[-3]"
      .Cells(lig, "L").NumberFormat = "#,##0.00€"
    End If
    'calcul du montant HT
    If IsNumeric(.Cells(lig, "I")) And IsNumeric(.Cells(lig, "K")) Then
      .Cells(lig, "L") = CDbl(.Cells(lig, "I")) * CDbl(.Cells(lig, "K"))
    Else
      .Cells(lig, "O") = ""
      .Cells(lig, "P") = ""
    End If
    'calcul des totaux montant HT, TVA5,5, TVA 19,6
    For i = lig To 1 Step -1
      If .Cells(i, "K") <> "REPORT" And .Cells(i, "K") <> "Quantité" Then
        If IsNumeric(.Cells(i, "L")) Then ctrMt = ctrMt + .Cells(i, "L")
        If IsNumeric(.Cells(i, "O")) Then ctrTVA7 = ctrTVA7 + .Cells(i, "O")
        If IsNumeric(.Cells(i, "P")) Then ctrTVA19 = ctrTVA19 + .Cells(i, "P")
      Else
        If IsNumeric(.Cells(i, "L")) Then ctrMt = ctrMt + .Cells(i, "L")
        If IsNumeric(.Cells(i, "O")) Then ctrTVA7 = ctrTVA7 + .Cells(i, "O")
        If IsNumeric(.Cells(i, "P")) Then ctrTVA19 = ctrTVA19 + .Cells(i, "P")
        Exit For
      End If
    Next i
    .Cells(lig + 1, "L") = ctrMt
    .Cells(lig + 1, "L").NumberFormat = "#,##0.00€"
    .Cells(lig + 1, "O") = ctrTVA7
    .Cells(lig + 1, "O").NumberFormat = "#,##0.00€"
    .Cells(lig + 1, "P") = ctrTVA19
    .Cells(lig + 1, "P").NumberFormat = "#,##0.00€"
    'Remise a zéro du formulaire
    ' TextBox1.Value = ""
    'TextBox2.Value = ""
    'Me.TextBox7 = ""
    ' TextBox3.Value = ""
    'TextBox9.Value = ""
    'TextBox5.Value = ""
    'TextBox8.Value = ""
    'TextBox4.Value = ""
    'OptionButton3.Value = False

    'Formatage du tableau


    .Cells(lig, "C").Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Range(.Cells(lig, "I"), .Cells(lig, "P")).Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Range(.Cells(lig, "C"), .Cells(lig, "M")).Borders(xlEdgeTop).LineStyle = xlNone
    .Range(.Cells(lig, "O"), .Cells(lig, "P")).Borders(xlEdgeTop).LineStyle = xlNone
    .Range(.Cells(lig, "C"), .Cells(lig, "M")).Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Range(.Cells(lig, "O"), .Cells(lig, "P")).Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Range(.Cells(lig, "D"), .Cells(lig, "H")).Borders(xlInsideVertical).LineStyle = xlNone
    .Range(.Cells(lig, "I"), .Cells(lig, "Q")).Borders(xlInsideVertical).LineStyle = xlContinuous
    .Range(.Cells(lig, "O"), .Cells(lig, "P")).VerticalAlignment = xlCenter

    .Range(.Cells(lig, "I"), .Cells(lig, "M")).VerticalAlignment = xlCenter

    DoEvents
    With .Range("C19:M" & lig & ",O19:P" & lig)
      .Font.Size = 14
      .Font.Name = "arial"
    End With
  End With
  Sheets("facture").Range("c19:M19,O19:P19").Borders(xlEdgeTop).LineStyle = xlContinuous


End Sub

pour éviter de mettre en double les codes et boutons pour alourdir le fichier

Pascal
 
Dernière édition:
Trier par date Trier par votes
grisan29

grisan29

XLDnaute Accro
Re : code pour 2 feuilles dans 2 boutons différents?????

Bonjour a vous

après de multiple essai je suis parvenu a comprendre quand mettant le code
Code: 
Sub Créer_La_Facture()
 Dim Sh As Worksheet, Trouve As Range
 Feuil9.Copy
 Set Sh = ActiveSheet
 Sh.Name = "Facture " & Sh.Range("G1").Value
 Sh.Range("D1") = "FACTURE  n°"
 With Sh
    With .Range("A:A")
        Set Trouve = .Find(What:="Arrêtée Somme", LookIn:=xlValues, _
            LookAt:=xlPart, MatchCase:=False, SearchDirection:=xlNext)
        If Not Trouve Is Nothing Then
            Trouve.Offset(1).Resize(20, 2).Delete (xlUp)
        End If
    End With
 End With
 End Sub
directement dans la feuille9 cela fonctionne mais alors comment faire pour que ce code créer un bouton qui permettrait de sauver la feuille dans le répertoire "facture"en incrémentant le n°
je vais y réfléchir de mon coté

Pascal
 
Vote positif 0 Vote négatif

Discussions similaires

Nicolas JACQUIN
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
848
Nicolas JACQUIN
Nicolas JACQUIN
S
  • Question
XL 2019 Problème dans un code vba
Réponses
2
Affichages
512
snoopy07
S
C
  • Question
Autres Enregistrer un code barre dans la cellule avant le titre qui est déja enregistré
Réponses
11
Affichages
652
Chatron
C
C
  • Question
Autres bug sur une procédure avec textbox contenant un code barre
2
Réponses
15
Affichages
1 K
TooFatBoy
TooFatBoy
C
  • Question
XL 2021 Problème de remplissage d'une colonne conditionné à d'autres valeurs
Réponses
2
Affichages
301
CathyLD
C
kalem
  • Question
Microsoft 365 [VBA] Enchaîner déplacer lignes + supprimer les lignes vides.
Réponses
3
Affichages
759
ARMAEL
A
lynyrd
  • Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
464
AtTheOne
AtTheOne
M
  • Question
Microsoft 365 Erreur sur mon Code VBA
Réponses
2
Affichages
297
Gégé-45550
Gégé-45550
L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
243
Latias
L
G
  • Résolu(e)
XL 2021 VBA dates au mauvais format
Réponses
5
Affichages
200
vgendron
vgendron

Membres actuellement en ligne

7 membres et 79 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 499
Messages
2 110 247
Membres
110 711
dernier inscrit
chmessi