1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
| Option Explicit 'Oblige VBA a te demander de déclarer toutes les variables que tu utilises dans ce module.
Sub Markers()
'Il est préférable et plus lisible, de déclarer toutes tes variables au début du code.
Dim ws As Worksheet
Dim Reponse2 As String, Station As String, DateRes As String, Lieu As String
Dim i As Long, Ext As Long, BCZ As Long
Dim c As Long, Nb As Long, Plate As Long, Puit As Long, colonne As Long, code As Long, BM As Long
Dim a As Range
Dim Ws_Ext As Worksheet, Ws_BCZ As Worksheet, Ws_ExtS As Worksheet, Ws_BczS As Worksheet, Ws_Obj As Worksheet
Application.ScreenUpdating = False
'suppression nombres stockés en texte
On Error Resume Next 'Attention avec ca, tu désactives le controle des erreurs, donc si ton code contient une erreur à partir d'ici ... tu le sauras jamais....
Set ws = Worksheets("Page 1")
On Error GoTo 0 'reactive la gestion d'erreur
If Not ws Is Nothing Then
For Each a In Worksheets("Page 1").Range("D:F,I:AC").SpecialCells(xlCellTypeConstants).Areas
a.Value = a.Value 'Que cherches tu as faire ici? ca ne me parait pas tres catholique :)
Next
'renommage feuille excel
ws.Name = "LIST"
End If
'nettoyage fichier
If Worksheets.Count > 1 Then
Application.DisplayAlerts = False
'reponse = MsgBox("Do you want to delete existing data (except the LIST sheet)?", vbYesNo)
If MsgBox("Do you want to delete existing data (except the LIST sheet)?", vbYesNo) = vbYes Then
Application.DisplayAlerts = False 'Toujours le mettre au plus pret du fait generateur de message
For Each ws In Worksheets
If UCase(ws.Name) <> "LIST" Then 'Pas sur que ca tienne compte de la case, mais si tu veux quand mm le faire autant mettre le faire comme ca
ws.Delete
End If
Next ws
Application.DisplayAlerts = True 'Et le réactiver des que plus necessaire
End If
End If
Reponse2 = MsgBox("Will you send only the males to BCZ? (if no the macro will be based on the blue color)", vbYesNo)
Station = InputBox("Please type your station (SRY, ALM...)")
'DateRes = ""'inutile deja initialisé a "" a sa création
DateRes = InputBox("When do you need the results? (you can leave it blank)")
If DateRes = 0 Then DateRes = ""
'MsgBox bm
Lieu = Mid(Worksheets("LIST").Cells(1, 3), 1, 4)
'MsgBox lieu
'tri BCZ/EXT
'Ne pas esité a créer plusieurs Worksheets, ca facilitera le code par la suite
Set Ws_Ext = Sheets.Add
Set Ws_BCZ = Sheets.Add
Set Ws_ExtS = Sheets.Add
Set Ws_BczS = Sheets.Add
Set Ws_Obj = Sheets.Add
Ws_Ext.Name = "EXT"
Ws_BCZ.Name = "BCZ"
Ws_ExtS.Name = "EXT samples"
Ws_BczS.Name = "BCZ samples"
Ws_Obj.Name = "Objective"
With Ws_Obj
'Worksheets("Objective").Cells(2, 4) = "DEMANDE D'ANALYSE MARQUAGE"
.Range("D2") = "DEMANDE D'ANALYSE MARQUAGE" 'Plus lisible sous cette forme
'Range("D2").Select'ne jamais selectionner toujours pointer
With .Range("D2").Font
.Size = 16
.Bold = True
.Color = -16776961
End With
With .Range("D2:H2").Borders 'ici astuce, Borders represente directement les 4 faces de la case ;)
.LineStyle = xlContinuous
.Weight = xlMedium
.LineStyle = xlContinuous
.Weight = xlMedium
.LineStyle = xlContinuous
.Weight = xlMedium
.LineStyle = xlContinuous
.Weight = xlMedium
End With
.Range("A6") = "1. OBJECTIF"
'Je te laisse modifier le reste |
Sélection ligne entière impossible après macro
Répondre avec citation
au bas de la discussion.
Envoyé par riomois85
Partager