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

145

    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. Kalajoen hukkuneet pojat olivat tummaihoisia

      Jälleen kerran, hukkuneet tai heikon uimataidon vuoksi vaaraan joutuneet olivat muita kuin suomalaisia. Turha viisastell
      Maailman menoa
      323
      7075
    2. Kysymys muille miehille

      Onko teille varattu nainen ongelma? Mikään muu naisessa ei töki kun se että hän on varattu. Kamppailen houkutuksen kanss
      Ikävä
      71
      4258
    3. Sinä eräs, pyydän......

      AUTA mua ole kiltti. Ei mun takia vaan.... Miten saan sut kiinni?
      Ikävä
      208
      3155
    4. Kohta katson sun kuvaasi

      ja päästän ajatukseni liitämään. Jo kuvasi näkeminen rauhoittaa, ja pistää hyrräämään vähän muutakin. Ihanan kaunista sa
      Ikävä
      24
      2937
    5. Nimikirjaimet

      Kuka kaipaa ketä 🥰
      Ikävä
      74
      1952
    6. VOI TÄTÄ ILON

      JA ONNEN PÄIVÄÄ 😂
      Tuusniemi
      149
      1781
    7. Ahneus iski Fazeriin, suklaalevy kutistuu 180 grammaan

      Kun mikään ei riitä. Shrinkflaatio. Mitä isot (Marabou) edellä, sitä pienet (Fazer) perässä. Pienikin voi siis olla a
      Maailman menoa
      212
      1746
    8. Jos kaivattusi on perääntynyt lähestyessäsi

      jossain tilanteessa, ymmärrätkö miksi hän saattoi tehdä sen?
      Ikävä
      165
      1560
    9. Minkä asian haluaisit muuttaa kaivatussasi?

      Mikä kaivattusi luonteessa tai ulkonäössä ärsyttää sua?
      Ikävä
      120
      1548
    10. Mies, ajattelemmekohan toisiamme juuri nyt?

      Olet mielessäni, vanhempi mies
      Ikävä
      89
      1438
    Aihe