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

164

    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. Rakas

      Eihän se tietysti minulle kuulu, mutta missä sinä olet? 😠
      Ikävä
      54
      2678
    2. Pidit itseäsi liian

      Vanhana minulle? Niinkö?
      Ikävä
      62
      2542
    3. SDP:n lyhyt selviytymisopas

      1. Komitea on vastaus, oli kysymys mikä tahansa Jos maailma on muuttumassa tai jossain palaa, demari ei hätiköi. Ensin p
      Maailman menoa
      26
      2046
    4. Joko olet luovuttanut

      Mun suhteen?
      Ikävä
      62
      1832
    5. Haluaisitko oikeasti

      Vakavampaa välillemme vai tämäkö riittää
      Ikävä
      55
      1805
    6. Kiva kun SDP alkaa hallitsemaan Suomea

      Vanhat hyvät ajat taas palaavat ja kansa vaurastuu. Muistatteko vielä Sorsan aikakauden? Silloin Suomessa tehtiin jopa
      Maailman menoa
      32
      1351
    7. Mitä se olisi

      Jos sinä mies saisit sanoa kaivatullesi mitä vain juuri nyt. Ilman mitään seuraamuksia yms. Niin mitä sanoisit?
      Ikävä
      41
      935
    8. Toivoisitko

      Toivoisitko, että kaivattusi olisi introvertimpi tai extrovertimpi? Itsenäinen tai tarvitsisi enemmän apua/sinua? Osoit
      Ikävä
      111
      857
    9. Nanna Karalahti :Paljastus bisneksistä Jere Karalahden kanssa!

      Ottanut yhteyttä seiskalehden toimittajaan ja kertonut totuuden yhteisestä Herotreeni-nimisestä verkkovalmenuksesta.
      Kotimaiset julkkisjuorut
      120
      826
    10. Sotekeskus

      Aloite on hyvä, kiitokset siitä. Mutta jos olette yhtään seuranneet hyvinvointialueen kokouksia niin sehän on jo nuijit
      Ähtäri
      37
      804
    Aihe