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

117

    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. Tänään pyörit ajatuksissa enemmän, kun erehdyin lukemaan palstaa

      En saisi, silti toivon että sinä vielä palaat ja otetaan oikeasti selvää, hioituuko särmät ja sulaudummeko yhteen. Vuod
      Ikävä
      31
      6119
    2. Huomenta ihana

      Kauniskasvoinen ihanuus 😘 saan sut vielä
      Ikävä
      34
      5633
    3. Hei rakas...

      Miten on työpäivä sujunut? Rakastan sinua 💗
      Ikävä
      29
      3154
    4. Edelleen sitä on vaikea uskoa

      Että olisit oikeasti rakastunut muhun
      Ikävä
      34
      2514
    5. Ei tämä etene ikinä

      Kun kumpikaan ei enää ota yhteyttä. Mä en ainakaan uskalla.
      Ikävä
      44
      2457
    6. Vitsi mihin menit. Heti takasin.

      Mä näin sut tuu takasin! Oli kiire, niin en ehtiny sin perään!
      Ikävä
      15
      2198
    7. Toiveikas vai toivoton

      torstai? Ajatuksia?
      Ikävä
      37
      2148
    8. Voi ei! Jari Sillanpää heitti keikan Helsingissä - Hämmästyttävä hetki lavalla...

      Ex-tangokuningas on parhaillaan konserttikiertueella. Hän esiintyi Savoy teatterissa äitienpäivänä. Sillanpää jakoi kons
      Suomalaiset julkkikset
      40
      1739
    9. Mukavaa päivää

      Mun rakkauden kohteelle ❤️ toivottavasti olet onnellinen
      Ikävä
      12
      1721
    10. En ole koskaan kokenut

      Ennen mitään tällaista rakastumista. Tiedän että kaipaan sinua varmaan loppu elämän. Toivottavasti ei tarvitsisi vain ka
      Ikävä
      19
      1707
    Aihe