fonction VBA

Question

Bonjour, 
J'ai besoin d'aide, je sais pas comment faire les fonctions, au fait j'ai un bout de code quis je repete, donc je voulais le mettre en fonction que j'appele a chaque fois que j'en ai besoin.

Voici le code:
       ' Mise en forme de la page Chiffrage
'========================================================================
    Cells(1, 1).Select
    ActiveCell.FormulaR1C1 = "Nom de l'affaire"
    Cells(2, 1).Select
    ActiveCell.FormulaR1C1 = "Ref de l'affaire"
    Range("A1:B1").Select
    Selection.MergeCells = True
    Cells(4, 1).Select
    ActiveCell.FormulaR1C1 = "Semaine"
    Cells(5, 1).Select
    ActiveCell.FormulaR1C1 = "Chantier"
    Cells(7, 1).Select
    ActiveCell.FormulaR1C1 = "Item"
    Cells(7, 2).Select
    ActiveCell.FormulaR1C1 = "Tache"
    Cells(7, 3).Select
    ActiveCell.FormulaR1C1 = "Q"
    Cells(5, 4).Select
    ActiveCell.FormulaR1C1 = "Horraire"
    Cells(4, 4).Select
    ActiveCell.FormulaR1C1 = "Nbre de monteur"
    Cells(7, 4).Select
    ActiveCell.FormulaR1C1 = "Nbre heure"
    Cells(7, 5).Select
    ActiveCell.FormulaR1C1 = "Achat"
    Cells(7, 6).Select
    ActiveCell.FormulaR1C1 = "Observation"
    Cells(5, 6).Select
    ActiveCell.FormulaR1C1 = "TOT heures"
    Cells(4, 9).Select
    ActiveCell.FormulaR1C1 = "TOTAL "
    Cells(5, 9).Select
    ActiveCell.FormulaR1C1 = "REEL"


'Fusionner les cellules
    Rows("3:3").Select
    Application.CutCopyMode = False
    Selection.MergeCells = True
    Rows("6:6").Select
    Selection.MergeCells = True
    Range("C4:C5").Select
    Selection.MergeCells = True
    Range("H4:H5").Select
    Selection.MergeCells = True
    Range("K4:AH4").Select
    Selection.MergeCells = True
    Range("K4:K5").Select
    Selection.MergeCells = True
    Range("C1:D1").Select
    Selection.MergeCells = True
    Range("C2:D2").Select
    Selection.MergeCells = True
    Range("E1:AH2").Select
    Selection.MergeCells = True
    Range("F4:G4").Select
    Selection.MergeCells = True
    
    Rows("1:7").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
    End With
    Range("G10").Select
    Range("C1:D1") = UserForm1.TextBox1
    Range("C2:D2") = UserForm1.TextBox2
     
 Merci d'avance

Configuration: Windows XP / Safari 534.13

ccm81 · Answer

bonjour,

on peut deja simplifier un peu puis 
quelque chose comme ça où Call tets1 appelle la procedure tets1

Private Sub CommandButton1_Click()
  Call test1
End Sub

Sub test1()
  ' affectations
    Cells(1, 1).Value = "Nom de l'affaire"
    Cells(2, 1).Value = "Ref de l'affaire"
    Cells(4, 1).Value = "Semaine"
    Cells(5, 1).Value = "Chantier"
    Cells(7, 1).Value = "Item"

  ' fusions
    Range("A1:B1").MergeCells = True
    Rows("3:3").MergeCells = True

  ' traces des bordures
    For Each c In Range("A1:Z7")
      c.Borders(xlDiagonalDown).LineStyle = xlNone
      c.Borders(xlDiagonalUp).LineStyle = xlNone
      c.Borders(xlEdgeLeft).LineStyle = xlContinuous
      c.Borders(xlEdgeTop).LineStyle = xlContinuous
    Next c
    
End Sub

michel_m · Answer

Bonjour à tous,

zeratule:

Une fonction ne renvoit qu'un objet (valeur, couleur, cellule....)

Pour toi il faut utiliser une fonction paramétrée
*par ex si c'est la mise en page identique de plusieurs folios et en utilisant la macro de ccm81

Sub mettre_en_page(onglet)
With Sheets(onglet)
    .Cells(1, 1).Value = "Nom de l'affaire"
    .Cells(2, 1).Value = "Ref de l'affaire"
    .Cells(4, 1).Value = "Semaine"
    .Cells(5, 1).Value = "Chantier"
    .Cells(7, 1).Value = "Item"

  ' fusions
    .Range("A1:B1").MergeCells = True
    .Rows("3:3").MergeCells = True
    ' traces des bordures
    .Range("A1:Z7").Borders.Weight = xlThin
End With

sub principale()
dim feuil1 as string
dim feuil2 as string

mettre_en_page feuil1
mettre_en_page feuil10

end sub

Nota: si c'est dans le m^me classeur, tu as beaucoup plus simple 
par exemple
Sheets(Array("Feuil1", "Feuil3")).Select
en première ligne de ta macro
et 
en dernière ligne
Sheets("Feuil1").Select

Ccm81

excuse l'incruste
peut-être encore plus simple pour trace des bordures :-) si tout du moins j'ai pigé son truc

Fonction VBA

2 réponses

Discussions similaires

Newsletters