• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

een LineFeed vinden in een Comment

Status
Niet open voor verdere reacties.
Probleem opgelost

Code: 
Private Sub Uitvoering()
  Dim Comtext As String, wordapp, WrdBestand As String, C As Comment, VarComment As String, selectedcell, Word, RijNummer As Integer
  Dim cl As Range, i As Integer, pos1(10) As Integer, pos2(10) As Integer, veld(10) As String, aantal As Integer, KL As String
  
  Worksheets("Blad1").Activate
  Set selectedcell = Application.ActiveCell
  KolomNummer = selectedcell.Column         ' GEEFT KOLOM NUMMER   https://www.educba.com/vba-active-cell/
  KL = Kolom_Letter(KolomNummer)            ' GEEFT KOLOMLETTER
  RijNummer = selectedcell.Row              ' GEEFT RIJNUMMER
  
  If ActiveCell.Comment Is Nothing Then
    Comtext = ""
      MsgBox ("1 Er is geen comment"), vbExclamation
    GoTo Uit
  Else
    Comtext = ActiveCell.Comment.Text
    If Comtext = "" Then
      MsgBox ("Er staat geen tekst in de Opmerking!")
      GoTo Uit
    End If
  End If
  
  WrdBestand = ActiveWorkbook.Worksheets("Blad1").Range("J10") & "\" & ActiveWorkbook.Worksheets("Blad1").Range("J12") & ".doc"     ' opent BASIS-FILE
  Set Word = CreateObject("word.basic")       ' Set Word
  Word.fileopen WrdBestand                    ' opent een Word document met het Path & Naam file & extensie
  Word.appshow                                ' toont het document
  
  With Range(KL & RijNummer)
    Set C = .Comment
    On Error GoTo 0
    If C Is Nothing Then
      MsgBox ("2 Er is geen comment"), vbExclamation
      VarComment = " "                        ' een spatie doorgeven anders foutmelding!
    Else
      VarComment = C.Text
    End If
  End With
    
    For Each cl In Selection.Cells
    aantal = 0
    For i = 1 To Len(VarComment)
      If Mid(VarComment, i, 1) = vbLf Then              ' laatste regel een vbLf
        aantal = aantal + 1
        If aantal = 1 Then pos1(1) = aantal
        If aantal > 1 Then pos1(aantal) = (pos1(aantal - 1) + pos2(aantal - 1) + 1)
        pos2(aantal) = i - pos1(aantal)
        veld(aantal) = Mid(VarComment, pos1(aantal), pos2(aantal))
        If i = Len(cl) Then Exit For
      End If
      If i = Len(VarComment) And aantal > 0 Then        ' één regel zonder vbLf
        aantal = aantal + 1
        pos1(aantal) = (pos1(aantal - 1) + pos2(aantal - 1) + 1)
        pos2(aantal) = (i + 1) - pos1(aantal)
        veld(aantal) = Mid(VarComment, pos1(aantal), pos2(aantal))
      End If
      If i = Len(VarComment) And aantal = 0 Then        ' twee regels één met vbLf en laatste zonder vbLf
        aantal = aantal + 1
        pos1(aantal) = (pos1(aantal - 1) + pos2(aantal - 1) + 1)
        pos2(aantal) = (i + 1) - pos1(aantal)
        veld(aantal) = Mid(VarComment, pos1(aantal), pos2(aantal))
      End If
    Next i
    
    With GetObject(WrdBestand)                                                    ' Update variabelen van Excel --> Word doc.
      For i = 1 To aantal
      .Variables("Veld" & i) = veld(i)
      .Fields.Update
      Next i
    End With
  Next
Uit:
End Sub

Thanks Edmoor leer weer steeds bij :-) mooie oplossing voor die kolom letter..

Cow18, morgen die van jouw proberen en snb
Nu even rust :-)
 
Laatst bewerkt:
Code: 
 With Range(KL & RijNummer)
is eigenlijk nog altijd activeCell of niet ?
Of anders with cells(rijnummer,kolomnummer), dan moet je geen letters gebruiken
of nog anders Cells(rijnummer, "Kolomletter(s)")
 
Laatst bewerkt:
Goedemiddag Cow18,

Ja klopt, men moet in de cel klikken en dan op de CommentBut klikken.

Heb hem even gefatsoeneerd en is versie 4.
Het werkt, maar ga nu die van jouw uitpluizen :-)
 

Bijlagen

Laatst bewerkt:
cow18 zei:
Code: 
[COLOR="#FF0000"]sp = Split(VarComment, vbLf)
          aantal = UBound(sp)[/COLOR]

          aantal = 0
          For i = 1 To Len(VarComment)
               If Mid(VarComment, i, 1) = vbLf Then             ' laatste regel een vbLf
                    aantal = aantal + 1
                    If aantal = 1 Then pos1(1) = aantal
                    If aantal > 1 Then pos1(aantal) = (pos1(aantal - 1) + pos2(aantal - 1) + 1)
                    pos2(aantal) = i - pos1(aantal)
                    veld(aantal) = Mid(VarComment, pos1(aantal), pos2(aantal))
                    If i = Len(cl) Then Exit For
               End If
               If i = Len(VarComment) And aantal > 0 Then       ' één regel zonder vbLf
                    aantal = aantal + 1
                    pos1(aantal) = (pos1(aantal - 1) + pos2(aantal - 1) + 1)
                    pos2(aantal) = (i + 1) - pos1(aantal)
                    veld(aantal) = Mid(VarComment, pos1(aantal), pos2(aantal))
               End If
               If i = Len(VarComment) And aantal = 0 Then       ' twee regels één met vbLf en laatste zonder vbLf
                    aantal = aantal + 1
                    pos1(aantal) = (pos1(aantal - 1) + pos2(aantal - 1) + 1)
                    pos2(aantal) = (i + 1) - pos1(aantal)
                    veld(aantal) = Mid(VarComment, pos1(aantal), pos2(aantal))
               End If
die 2 rode regels doen net hetzelfde als de erna volgende zwarte regels.
Alleen opletten, sp start bij 0, niet bij 1.
Klik om te vergroten...

Vraagje Cow18,

Klopt het dat deze 2 regels (rood) uiteindelijk het aantal regels geeft in deze string (VarComment) met "aantal" + 1 ?
En nog een vraagje :-) Als wat moet ik sp Dimensioneren? string werkt niet en integer ook niet.


1e kijk: deze:
Code: 
 Dim sp, regels As Integer
    sp = Split(VarComment, vbLf)
    regels = UBound(sp) + 1                   ' start bij 0 dus plus 1
  MsgBox ("regels =  " & regels)
regels geeft dus het totaal aantal regels in de Comment. Loop ik tegen het probleem aan om in het Word Tabel Veld(1), Veld(2), Veld(3) enz. neer te kunnen zetten.
Heb dus nog steeds de Teller "aantal" nodig.
Kan hem wel gebruiken om "For i = 1 To Len(VarComment)" te vervangen door "For i = 1 to regels"
 
Laatst bewerkt:
Code: 
Dim sp    As Variant 'maar is eigenlijk hetzelfde als niets erachter
...
     For Each cl In Selection.Cells
          sp = Split(VarComment, vbLf)

          With GetObject(WrdBestand)                            ' Update variabelen van Excel --> Word doc.
               For i = 0 To application.min(3,UBound(sp))  'maximaal 4 velden
                    .Variables("Veld" & i + 1) = sp(i)
                    .Fields.Update
               Next i
          End With
     Next
 
Laatst bewerkt:
Hoi Cow18,

pff uren bezig geweest. was iets veranderd in de tabel van het word document.
Enfin, staat weer goed.

even gekeken naar wat je inbracht.

Heb de tabel vergroot naar 10 rijen, maar worden (denk ik) zo'n 30 a 40. (hangt van A4 af, wat erop kan)

Dus dan moet je alle variabelen iets geven om het naar het word document te brengen (anders foutmelding)

De opzet is om meerdere comment's tekst in deze tabel te kunnen brengen en uit te printen. (dus alles bij elkaar op één document)

Had het volgende bedacht voor één comment (stap voor stap)

Code: 
Private Sub Cow18()
  Dim Comtext As String, wordapp, WrdBestand As String, C As Comment, VarComment As String, selectedcell, Word, RijNummer As Integer
  Dim cl As Range, i As Integer, pos1(10) As Integer, pos2(10) As Integer, veld(10) As String, aantal As Integer, KL As String
  
  Worksheets("Blad1").Activate
  Set selectedcell = Application.ActiveCell
  KolomNummer = selectedcell.Column         ' GEEFT KOLOM NUMMER   https://www.educba.com/vba-active-cell/
  KL = Kolom_Letter(KolomNummer)            ' GEEFT KOLOMLETTER
  RijNummer = selectedcell.Row              ' GEEFT RIJNUMMER
  
  If ActiveCell.Comment Is Nothing Then
    Comtext = ""
      MsgBox ("1 Er is geen comment"), vbExclamation
    GoTo Uit
  Else
    Comtext = ActiveCell.Comment.Text
    If Comtext = "" Then
      MsgBox ("Er staat geen tekst in de Opmerking!")
      GoTo Uit
    End If
  End If
  
  WrdBestand = ActiveWorkbook.Worksheets("Blad1").Range("K7") & "\" & ActiveWorkbook.Worksheets("Blad1").Range("K9") & ".doc"     ' opent BASIS-FILE COMMENT
  Set Word = CreateObject("word.basic")       ' Set Word
  Word.fileopen WrdBestand                    ' opent een Word document met het Path & Naam file & extensie
  Word.appshow                                ' toont het document
  
  With Range(KL & RijNummer)
    Set C = .Comment
    On Error GoTo 0
    If C Is Nothing Then
      MsgBox ("2 Er is geen comment"), vbExclamation
      VarComment = " "                        ' een spatie doorgeven voor Word anders foutmelding!
    Else
      VarComment = C.Text
    End If
  End With
 ' Dim sp As Variant, regels As Integer, Adres As Variant
 '   sp = Split(VarComment, vbLf)
 '   regels = UBound(sp) + 1                   ' start bij 0 dus plus 1
 ' MsgBox ("regels =  " & regels)
 
  For Each cl In Selection.Cells
    Adres = "cel-adres = " & cl.Address
    
    aantal = 0
    For i = 1 To Len(VarComment)
      If Mid(VarComment, i, 1) = vbLf Then              ' laatste regel een vbLf
        aantal = aantal + 1
        If aantal = 1 Then pos1(1) = aantal
        If aantal > 1 Then pos1(aantal) = (pos1(aantal - 1) + pos2(aantal - 1) + 1)
        pos2(aantal) = i - pos1(aantal)
        veld(aantal) = Mid(VarComment, pos1(aantal), pos2(aantal))
        If i = Len(cl) Then Exit For
      End If
      If i = Len(VarComment) And aantal > 0 Then        ' één regel zonder vbLf
        aantal = aantal + 1
        pos1(aantal) = (pos1(aantal - 1) + pos2(aantal - 1) + 1)
        pos2(aantal) = (i + 1) - pos1(aantal)
        veld(aantal) = Mid(VarComment, pos1(aantal), pos2(aantal))
      End If
      If i = Len(VarComment) And aantal = 0 Then        ' twee regels één met vbLf en laatste zonder vbLf
        aantal = aantal + 1
        pos1(aantal) = (pos1(aantal - 1) + pos2(aantal - 1) + 1)
        pos2(aantal) = (i + 1) - pos1(aantal)
        veld(aantal) = Mid(VarComment, pos1(aantal), pos2(aantal))
      End If
    Next i
  Next
  
  With GetObject(WrdBestand)                                                    ' Update variabelen van Excel --> Word doc.
    For i = 0 To 10
      If i = 0 Then .Variables("veld" & i) = Adres: GoTo Door
      If veld(i) = "" Then veld(i) = ".": .Variables("veld" & i) = veld(i): GoTo Door
      .Variables("veld" & i) = veld(i) ': MsgBox ("2 i =  " & i)
Door:
    Next i
    .Fields.Update
  End With
Uit:
End Sub
Had een aparte sub voor je aangemaakt, maar is (nog) niet veel anders als die andere sub (Uitvoering).
 

Bijlagen

Laatst bewerkt:
ik heb je bestandje niet geopend, maar ik zou het eenvoudig zo doen
Code: 
    s = vbLf & varcomment & WorksheetFunction.Rept(vbLf, 40)   'voeg vooraan 1 vblf (voor je adres straks) en achteraan nog voldoende (40) vblf's toe aan je varcomment
     MsgBox "dit wordt straks gesplitst : " & vbLf & s
     sp = Split(s, vbLf)                                        'splits dan op die vblf

     With GetObject(WrdBestand)                                 ' Update variabelen van Excel --> Word doc.
          For i = 0 To 10
               Select Case i
                    Case 0: .variables("veld0") = Adres
                    Case Else: .variables("veld" & i) = IIf(sp(i) = "", ".", sp(i))     'was het knipsel leeg, zet er dan een punt in, anders het knipsel zelf
               End Select
          Next i
          .Fields.Update
     End With
 
ok Cow18 dit gaat dus over het wegschrijven naar het Word document.

even kijken :-)

welke dimension heeft s?
 
Laatst bewerkt:
Cow werkt goed thanks, maar wat is het voordeel / nadeel met wat ik al had?
misschien iets sneller? geen goto erin
 

Bijlagen

Laatst bewerkt:
welke dimension heeft s?
Klik om te vergroten...
Vroeger was ik ook strikter op het netjes declareren van je variabelen, zelfs met option explicit.
Daar ben ik van afgestapt, een mogelijkheid tot een heftige discussie over de pro's en de contra's, maar nu ben ik overtuigd contra.
Niets belet er je pro te zijn.
maar wat is het voordeel / nadeel met wat ik al had?
Klik om te vergroten...
niets, alle wegen leiden/lijden naar Rome. Het resultaat telt, meestal niet de manier waarop, zou Machiavelli zeggen.

PS. ik heb je bestand niet nagelezen/geopend.
 
Laatst bewerkt:
Goedenavond Cow18,

Ok dan zit nog in vroeger :-)
Gebruik namelijk wel option explicit. Wel zo makkelijk, voor check of alles gedimm. is.

Maak niet uit ieder zijn manier.

Wat betreft het laatste, weet zeker dat jullie hier mooiere formules hebben, daarom kom ik ook met vragen hier.
Kijk als zo een formule sneller is en korter, dat zijn toch de dingen waar je voor gaat.

Weet nu bv. hoe ik regels kan tellen in een Comment..

Zit nog met een probleempje, waar ik uit moet zien te komen, namelijk
kijk om een comment over te zetten naar een tabel in Word en dan uit te printen is ook een beetje overdreven.
Leek me mooier dat ik meerdere comment´s dan tegelijk uit kon printen op een pagina.

Dus opdracht die ik mezelf dan weer geef is om meerdere comments te kunnen aanklikken en overzetten naar Word
en dat er tijd een melding komt als de pagina vol is.

Voor ik het vergeet, bedankt allemaal voor de inzet en hulp.

Ga nu verder op

https://www.helpmij.nl/forum/showthread.php/962119-Check-Word-document-open?p=6308945

voor het checken of een Word-document al open is
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan