tiedot kommenttikenttään omille "sarakkeille"

kommenttikikkailija

Pystyykö jollain koodilla, vb:llä ym. siirtämään esimerkiksi Taul2 A1-10 - F1-10 eli 7 sarakkeen tiedot Taul1 A1 kommenttikenttään omiksi sarakkeiksi painonapilla tai enteriä painamalla? Kommenttikenttään tulisi voida siirtää tietoa vapaasti haluamassaan järjestyksessä vaikka vain rivi kerrallaan.

Taulujärjestys voi olla myös Taul1 =>Taul2.

4

86

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • Tämmöinen

      Tarkoitatko mahdollisesti jotain tällaista:
      Sub kommentti()                                                                                    
      On Error Resume Next                                                                             
         Set alue = Worksheets("Sheet1").Range("A1:F10")                                        Set komm = Worksheets("Sheet2").Range("A1")                                        
         If Intersect(Selection, alue) Is Nothing Then                                                   komm.Comment.Delete                                                                          Else                                                                                                         nC = alue.Columns.Count                                                                          r1 = WorksheetFunction.Max(alue.Row, Selection.Row)                                  r2 = WorksheetFunction.Min(alue.Row   alue.Rows.Count - 1, _                                                 Selection.Row   Selection.Rows.Count - 1)                      l = 0                                                                                                     For Each s In alue                                                                                      l = WorksheetFunction.Max(l, Len(s)   2)                                                 Next s                                                                                           
            rivit = komm.Comment.Text                                                                      If Len(rivit) > 0 Then rivit = rivit & Chr(10)                                                  For R = r1 To r2                                                                                         For C = 1 To nC                                                                                         rivit = rivit & Left(alue(R, C) & Space(l), l)                                                Next C                                                                                                  If R < r2 Then rivit = rivit & Chr(10)                                                         Next R                                                                                           
            With komm                                                                                               .AddComment                                                                                         With .Comment                                                                                          .Visible = False                                                                                       .Text Text:=rivit                                                                                     With .Shape.TextFrame                                                                               .Characters.Font.Name = "Courier New"                                                       .Characters.Font.Size = 8                                                                         .AutoSize = True                                                                                 End With                                                                                            End With                                                                                           End With                                                                                            End If                                                                                                 End Sub

    • kommenttikikkailija

      Kiitos Tämmönen vb-koodista.
      Hieman repeillyt tuo koodi näyttää olevan, mutta varmaankin toimiva.
      Pitääkö tämä tulla johonkin tiettyyn paikkaan eli moduuliin, tiettyyn Tauluun vaiko Tähän työkirjaan ja onko tuo sellainen, että se on jatkuvasti aktiivinen -huono ilmaisu- vai pitääkö se "käynnistää" jotenkin että tekee jotain?

    • Tämmöinen

      Tulee moduliin ja sitä pitää kutsua erikseen. Sen voi linkittää vaikka nappiin. Makro liittää muuttujassa komm määrätyn solun kommenttiin tiedot alueen A1:F10 niiltä riveiltä, jotka ovat maalattuna. Kommentti poistetaan, jos aktiivinen solu on tuon alueen ulkopuolella. Makro ei tarkista rivien järjestystä tai sitä tuleeko sama rivi useaan kertaan. Alla sama makro ilman yritystä muotoilla sitä luettavammaksi.

      Sub kommentti()
      On Error Resume Next
      Set alue = Worksheets("Sheet1").Range("A1:F10")
      Set komm = Worksheets("Sheet2").Range("A1")
      If Intersect(Selection, alue) Is Nothing Then
      komm.Comment.Delete
      Else
      nC = alue.Columns.Count
      r1 = WorksheetFunction.Max(alue.Row, Selection.Row)
      r2 = WorksheetFunction.Min(alue.Row alue.Rows.Count - 1, Selection.Row Selection.Rows.Count - 1)
      l = 0
      For Each s In alue
      l = WorksheetFunction.Max(l, Len(s) 2)
      Next s

      rivit = komm.Comment.Text

      If Len(rivit) > 0 Then rivit = rivit & Chr(10)
      For R = r1 To r2
      For C = 1 To nC
      rivit = rivit & Left(alue(R, C) & Space(l), l)
      Next C
      If R < r2 Then rivit = rivit & Chr(10)
      Next R

      With komm
      .AddComment
      With .Comment
      .Visible = False
      .Text Text:=rivit
      With .Shape.TextFrame
      .Characters.Font.Name = "Courier New"
      .Characters.Font.Size = 8
      .AutoSize = True
      End With
      End With
      End With
      End If
      End Sub

    • kommenttikikkailija

      Kiitos Tämmönen, sain tämän toimimaan varmaan niin kuin sen pitääkin toimia.
      Hieman pitikin tosiaan testailla miten tämä lopulta toimi.
      Paljon olisi kysymyksiä, mutta koitan ensin viilailla tätä jos se taipuisi kokeiluihini. :)

    Ketjusta on poistettu 0 sääntöjenvastaista viestiä.

    Luetuimmat keskustelut

    1. Olen tosi outo....

      Päättelen palstajuttujen perusteella mitä mieltä minun kaipauksen kohde minusta on. Joskus kuvittelen tänne selkeitä tap
      Ikävä
      16
      2128
    2. Kotkalainen Demari Riku Pirinen vangittu Saksassa lapsipornosta

      https://www.kymensanomat.fi/paikalliset/8081054 Kotkalainen Demari Riku Pirinen vangittu Saksassa lapsipornon hallussapi
      Kotka
      84
      2068
    3. Oletko sä luovuttanut

      Mun suhteeni
      Ikävä
      101
      1377
    4. Vanhalle ukon rähjälle

      Satutit mua niin paljon kun erottiin. Oletko todella niin itsekäs että kuvittelet että huolisin sut kaiken tapahtuneen
      Ikävä
      10
      1176
    5. Hommaatko kinkkua jouluksi?

      Itse tein pakastimeen n. 3Kg:n murekkeen sienillä ja juustokuorrutuksella. Voihan se olla, että jonkun pienen, valmiin k
      Sinkut
      145
      1170
    6. Maisa on SALAKUVATTU huumepoliisinsa kanssa!

      https://www.seiska.fi/vain-seiskassa/ensimmainen-yhteiskuva-maisa-torpan-ja-poliisikullan-lahiorakkaus-roihuaa/1525663
      Kotimaiset julkkisjuorut
      81
      1143
    7. Aatteleppa ite!

      Jos ei oltaisikaan nyt NATOssa, olisimme puolueettomana sivustakatsojia ja elelisimme tyytyväisenä rauhassa maassamme.
      Maailman menoa
      249
      886
    8. Omalääkäri hallituksen utopia?

      Suurissa kaupungeissa ja etelässä moinen onnistunee. Suuressa osassa Suomea on taas paljon keikkalääkäreitä. Mitenkäs ha
      Maailman menoa
      172
      858
    9. Mitä sanoisit

      Ihastukselle, jos näkisitte?
      Tunteet
      63
      834
    10. Onko se ikä

      Alkanut haitata?
      Ikävä
      59
      811
    Aihe