Macro copier plage avec condition textbox

r0man0
Messages postés
41
Date d'inscription
vendredi 3 décembre 2010
Statut
Membre
Dernière intervention
11 février 2014
- 25 sept. 2012 à 13:27
cs_MPi
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018
- 26 sept. 2012 à 18:03
Bonjour,
J'ai un petit soucis j'ai une plage de données comprenant de 50 à 500 lignes, chaque lignes correspondant à un point de passage géoreférencé, comme des waypoints sur un gps, en faîtes j'aimerai pouvoir lui dire, (si il compte plus de 300 étapes), "comme la tu vas dépasser ta limite d'affichage, tu vas prendre toutes mes étapes du premier à celle que je vais t'indiquer dans une textbox et tu vas m'écrire mon fichier .rte, et tu vas prendre toutes mes étapes de celle que je t'ai indiqué à la dernière et tu vas m'écrire mon fichier .rte" voilà, grossomodo.
Sachant que dans ma plage j'ai une colonne "nom" qui correspond aux abréviations que j'utilise pour mes étapes, et que j'aimerai utiliser pour ma condition d'écriture.
J'ai trouvé une solution, mais ça ne fonctionne pas, bon je crois avoir fait des erreurs mais j'avoue que mes yeux et mon esprit fatigue un peu, je post le code,

Sub FICELLERTE()

Dim Destination, MaPlage, PL, R, DEST As Range
Dim Fs, U As Object
Dim FIC, ErrMsg, mot, PA As String
Dim K As Long
Dim Result, Choices, DL As Integer


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Work_Sheet_2").Select
Cells.ClearContents
Sheets("RTE_FLITESTAR").Select
Cells.ClearContents
Sheets("Compilation").Select
Set Destination = Sheets("Work_Sheet_2").Range("A1")
Set MaPlage = Sheets("Compilation").Range("A1:M" & Sheets("Compilation").Range("A65536").End(xlUp).Ro w)
Set tbl = ActiveCell.CurrentRegion


tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
MaPlage.Copy Destination

With Sheets("Work_Sheet_2")

Range("N1").FormulaR1C1 = "1"

Cells.Find("*", after:=[A1], LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, searchdirection:=xlPrevious, _
MatchCase:=False, SearchFormat:=False).Select

n = Selection.Row
mot = InputBox("Donnez code OACI")
DL = .Cells(Application.Rows.Count, 1).End(xlUp).Row
Set PL = .Range("T1:T" & DL)
Set R = PL.Find(mot, , xlValues, xlWhole)
End With

If Not R Is Nothing Then
PA = R.adress

With Sheets("RTE_FLITESTAR")
Set DEST IIf(.Cells(1, 1) "", .Cells(1, 1), .Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0))
End With

With Sheets("Work_Sheet_2")
If n > 299 Then
MsgBox ("Dépassement de la capacité de traitement ROUTE (>300)")
For compteur = 1 To PA
.Range("T1:T" & compteur).Value.Copy DEST
Next compteur
End If
End With

For i = 1 To n
Cells(i, 14).FormulaR1C1 = _
"=R[-1]C+1"
Cells(i, 15).FormulaR1C1 = _
"=RC[-9]+((500*RC[-8]+3*RC[-7])/30000)"
Cells(i, 17).FormulaR1C1 = _
"=RC[-7]+((500*RC[-6]+3*RC[-5])/30000)"
Cells(i, 16).FormulaR1C1 = _
"=IF(RC[-11]=""s"",-RC[-1],RC[-1])"
Cells(i, 18).FormulaR1C1 = _
"=IF(RC[-9]=""W"",-RC[-1],RC[-1])"
Cells(i, 20).FormulaR1C1 = _
"=CONCATENATE(""W, 0, "",C[-6],"", "",C[-6],"","",C[-16],"" , "",C[-4],"", "",C[-2],"",39154.4176025, 111, 4, 5, 255, 13158342,0, 0, 0"")"
Next i

Range("T1:T65000").Copy

Sheets("RTE_FLITESTAR").Columns("A:A").PasteSpecia l Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Sheets("RTE_FLITESTAR").Select
For j = 1 To 5
Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Next j

Range("A1").FormulaR1C1 = "OziExplorer Route File Version 1.0"
Range("A2").FormulaR1C1 = "WGS 84"
Range("A3").FormulaR1C1 = "Reserved 1"
Range("A4").FormulaR1C1 = "Reserved 2"
Range("A5").FormulaR1C1 = "R, 0,R0 ,,255"

Set Fs = CreateObject("Scripting.FileSystemObject")
Set U = Fs.CreateTextFile("\\Etudes\public\03_MISSION\01_P REPARATION_MISSION\OUTIL ROUTE FLITESTAR\Route\RTE_FLITESTAR.rte", True)
With Sheets("RTE_FLITESTAR")
For K = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
On Error GoTo Errorhandler
U.WriteLine (.Range("A" & K).Value)
Next K

Errorhandler:

Select Case Err.Number

Case 13:
ErrMsg = "Une erreur est survenue ligne " & K - 5 & " de la feuille Compilation."

Result = MsgBox(ErrMsg, Choices)

If Result = vbOK Then
Resume Next
End If
End Select
U.Close
Set U = Nothing
Set Fs = Nothing
NOM = InputBox("Donnez un nom de fichier.wpt")
If NOM = "" Then
Exit Sub
Else
GoTo continu
End If
continu:
FIC = Dir("\\Etudes\public\03_MISSION\01_PREPARATION_MIS SION\OUTIL ROUTE FLITESTAR\Route\RTE_FLITESTAR.rte")
If FIC <> "" Then Name "\\Etudes\public\03_MISSION\01_PREPARATION_MISSION \OUTIL ROUTE FLITESTAR\Route" _
& FIC As "\\Etudes\public\03_MISSION\01_PREPARATION_MISSION \OUTIL ROUTE FLITESTAR\Route" & NOM & ".rte"
End With
Sheets("Main_Sheet").Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox ("Export ROUTE réussi")
End If
End Sub


En faite, j'appel une fenêtre qui me demande de taper mon mot clé, elle le cherche, le trouve, l'identifie dans ma plage et lance une copie de la ligne 1 à la ligne contenant mon mot clé gràce à mon compteur vers ma feuille RTE_FLITESTAR, et pareil de la ligne de mon mot clé à la dernière ligne.
Bon ça commence à devenir laborieux pour moi, je sèche complètement.

Merci.

1 réponse

cs_MPi
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018
20
26 sept. 2012 à 18:03
Je n'ai pas tout étudié le code, mais bon...

Tu écris ceci qui te retourne une adresse du genre $T$345
PA = R.adress


Et tu écris ceci où PA devrait être le numéro de ligne, j'imagine, mais pas une adresse
For compteur = 1 To PA
.Range("T1:T" & compteur).Value.Copy DEST
Next compteur


Donc, je pense que tu devrais utiliser
PA = R.Row

ou encore
For compteur = 1 To PA.Row


MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI
0