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

[grisan29]

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

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

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

 

[grisan29]

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

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

 

[Pierrot93]

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

Bonjour,

voir aussi ici :
création d'un bouton automatiquement : Excel - VBA
bonne journée
@+

 

[grisan29]

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

bonjour Pierrot93
pour trouver la meilleure solution il faut mettre tout en œuvre pour trouver le bon compromis 😛
Pascal

 

[Pierrot93]

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

Re,

pas de souci, mais préférable de prévenir dans ce cas...

 

[grisan29]

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

bonjour Pierrot93
mes excuses de ne pas avoir prévenu de butiner et par ce biais je pense trouvé une réponse correspondante a ma demande

Pascal