inscription dans cellule (VBA)

J

JJ1

Guest
Bonjour à tous,

Hier soir j'ai préparé un fichier que j'ai fini pour connaître la possibilité par VBA (uniquement je pense) d'inscrire dans une cellule deux inscriptions:
en bas de cellule, la "série"
en haut de cellule les valeurs à inscrire correspondantes aux données valeurs.
(en format texte?)

Je joins un bout d'exemple du fichier préparé.

merci de votre aide.
Bonne journée
 

Pièces jointes

  • inscription.xls
    31.5 KB · Affichages: 43
  • inscription.xls
    31.5 KB · Affichages: 50
  • inscription.xls
    31.5 KB · Affichages: 49

fanfan38

XLDnaute Barbatruc
Re : inscription dans cellule (VBA)

Bonjour
Je verrai bien une macro dans ce genre là:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column > 14 Then Exit Sub
Range("R5").Value = CStr(Range("b5").Value) & Chr(13) & Chr(10) & CStr(Range("d6").Value)
End Sub
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : inscription dans cellule (VBA)

Bonjour JJ1,

Comme je n'ai pas compris grand chose, un exemple pour gérer les formats texte dans une cellule.
Code à mettre dans le module de Feuil1:
VB:
Sub toto()
Const Espacement = 2
Dim Nretour
  With Sheets("Feuil1").Cells(5, "r")
    .Value = "9 - > 12" & String(Espacement, vbLf) & "1 - 2"
    Nretour = InStr(.Text, String(Espacement, vbLf))
    With .Characters(Nretour + Espacement, 99).Font
      .FontStyle = "Gras"
      .Size = 14
    End With
  End With
End Sub
 
Dernière édition:
J

JJ1

Guest
Re : inscription dans cellule (VBA)

Bonjour Fanfan, mapomme,
Merci pour vos réponses.
J'explique plus en détail:
le tableau se compose en 4 parties:
série (col A), valeurs (B:F), à inscrire (H:L), les cases numérotées de 1 à 16 en O:R où inscrire.

le principe pour chaque valeur de 1 à 16 est d'inscrire dans sa case la série où il se retrouve et les nombres à inscrire correspondants aussi (H:L)
ex pour la case 4, il faudrait inscrire les séries 1 et 2 en bas et en haut de la case les valeurs à inscrire soit 9 et >12

merci à vous.
 

job75

XLDnaute Barbatruc
Re : inscription dans cellule (VBA)

Bonjour à tous,

Voyez cette macro dans le fichier joint :

Code:
Sub Inscrire()
Dim P1 As Range, P2 As Range, col%, Ncol%, cel As Range
Dim n&, c1 As Range, c2 As Range, t As Boolean
Set P1 = [O5:R8]
Set P2 = [B5:F65536]
col = P2.Column - 1 'colonne du n° de série
Ncol = P2.Columns.Count
P1.ClearContents
For Each cel In P1
  n = n + 1
  Set c1 = P2.Find(n, P2(P2.Rows.Count, Ncol), xlValues, xlWhole)
  If Not c1 Is Nothing Then
    Set c2 = P2.Find(n, c1)
    t = c2.Address <> c1.Address
    cel = c1(1, Ncol + 2) & IIf(t, " - " & c2(1, Ncol + 2), "") & vbLf _
      & Cells(c1.Row, col) & IIf(t, " - " & Cells(c2.Row, col), "")
    With cel.Characters(InStr(cel, vbLf)).Font
      .Size = 14
      .Bold = True
    End With
  End If
Next
End Sub
A+
 

Pièces jointes

  • inscription(1).xls
    51 KB · Affichages: 32

job75

XLDnaute Barbatruc
Re : inscription dans cellule (VBA)

Re,

Quand on re-clique sur le bouton l'effacement du tableau est visible.

Ceci l'évite :

Code:
Sub Inscrire()
Dim P1 As Range, P2 As Range, col%, Ncol%, cel As Range
Dim n&, c1 As Range, c2 As Range, t As Boolean
Set P1 = [O5:R8]
Set P2 = [B5:F65536]
col = P2.Column - 1 'colonne du n° de série
Ncol = P2.Columns.Count
For Each cel In P1
  n = n + 1
  Set c1 = P2.Find(n, P2(P2.Rows.Count, Ncol), xlValues, xlWhole)
  If c1 Is Nothing Then
    cel = ""
  Else
    Set c2 = P2.Find(n, c1)
    t = c2.Address <> c1.Address
    cel = c1(1, Ncol + 2) & IIf(t, " - " & c2(1, Ncol + 2), "") & vbLf _
      & Cells(c1.Row, col) & IIf(t, " - " & Cells(c2.Row, col), "")
    With cel.Characters(InStr(cel, vbLf)).Font
      .Size = 14
      .Bold = True
    End With
  End If
Next
End Sub
Fichier (2).

A+
 

Pièces jointes

  • inscription(2).xls
    58.5 KB · Affichages: 33

Discussions similaires

Statistiques des forums

Discussions
312 924
Messages
2 093 669
Membres
105 781
dernier inscrit
Dominique G.