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

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:

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
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 926
Membres
101 841
dernier inscrit
ferid87