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

VBA code werkt opeens niet meer

Status
Niet open voor verdere reacties.

amarob

Gebruiker
Lid geworden
23 feb 2014
Berichten
68
Hallo,

Ik gebruik een VBA code om alleen tekst vanuit samengevoegde cellen te kopiëren naar het klembord. Die code heeft altijd heel goed gewerkt maar nu opeens niet meer en krijg ik in plaats van tekst twee vette balkjes naast elkaar als resultaat als ik het plak in word. De VBA code is:

Sub kopieer_motivatie_ritten()
'
' kopieer_motivatie_ritten Macro
'

'
Range("O71:W74").Select
Selection.Copy


Dim clibboardFieldDelimiter As String
Dim clibboardLineDelimiter As String
Dim row As Range
Dim cell As Range
Dim cellValueText As String
Dim clipboardText As String
Dim isFirstRow As Boolean
Dim isFirstCellOfRow As Boolean
Dim dataObj As New DataObject

clibboardFieldDelimiter = Chr(9)
clibboardLineDelimiter = Chr(13) + Chr(10)
isFirstRow = True
isFirstCellOfRow = True

For Each row In Selection.Rows

If Not isFirstRow Then
clipboardText = clipboardText + clibboardLineDelimiter
End If

For Each cell In row.Cells

If IsEmpty(cell.Value) Then

cellValueText = ""

ElseIf IsNumeric(cell.Value) Then

cellValueText = LTrim(Str(cell.Value))

Else

cellValueText = cell.Value

End If ' -- Else Non-empty Non-numeric

If isFirstCellOfRow Then

clipboardText = clipboardText + cellValueText
isFirstCellOfRow = False

Else ' -- Not (isFirstCellOfRow)

clipboardText = clipboardText + clibboardFieldDelimiter + cellValueText

End If ' -- Else Not (isFirstCellOfRow)

Next cell

isFirstRow = False
isFirstCellOfRow = True

Next row

clipboardText = clipboardText + clibboardLineDelimiter

dataObj.SetText (clipboardText)
dataObj.PutInClipboard

End Sub


Wat kan het probleem zijn?
 
Het ontbreken van code tags in je bericht.
Het ontbreken van een voorbeeldbestand.
 
Laatst bewerkt:
Sluit alle verkenner vensters voordat je probeert deze code uit te voeren.
 
Naast het bovenstaande, gebruik voor het aan elkaar plakken van tekst niet het + maar het & teken.
 
En wat moet de uitkomst zijn van de code die je in #1 plaatste?
 
63 modules!
Tientallen lege sub's
Dit soort code:
Code:
    Range("B3").Select
    Selection.ClearContents
    Range("B4").Select
    Selection.ClearContents
    Range("B5").Select
    Selection.ClearContents
    Range("B6").Select
    Selection.ClearContents
    Range("B7").Select
    Selection.ClearContents
Eerst eens herstructureren zou ik zeggen.
 
Ik keek alleen naar de code in #1, dat kan ook een heel stuk beter.
Maar vragenstellers zijn hier om wat te leren :)
 
63 modules!
Tientallen lege sub's
Dit soort code:
Code:
    Range("B3").Select
    Selection.ClearContents
    Range("B4").Select
    Selection.ClearContents
    Range("B5").Select
    Selection.ClearContents
    Range("B6").Select
    Selection.ClearContents
    Range("B7").Select
    Selection.ClearContents
Eerst eens herstructureren zou ik zeggen.

Lege sub's heb ik opgeschoond maar probleem is hiermee helaas niet opgelost.
 
Het kan allemaal IETS eenvoudiger. Vervang de code uit je openingsbericht eens door:

Code:
Sub kopieer_motivatie_ritten()
    Kopieer_naar_clipboard Range("O71")
End Sub


Kopieer_naar_clipboard (Rng)
    Dim dataObj As New DataObject
    dataObj.SetText Rng
    dataObj.PutInClipboard
End Sub

En dat geldt voor meer kopieeracties naar het clipboard.
Bovendien hoef je de sub met de kopieeractie niet telkens in zijn geheel te kopiëren met slechts een ander bereik als bron.
Je had hem ook zo kunnen aanroepen, net zoals dat met bovenstaand subje gebeurt:
Code:
Sub Kopieer_naar_clipboard(Range("O71"))
 
Hallo,

Bedankt allemaal voor oplossingsrichtingen. Het probleem is opgelost. Het probleem zat niet in het excel bestand maar in mijn profielinstellingen. Die zijn allemaal opgeschoond en daarna was het probleem er niet meer.
Probleem is dus opgelost.
 
Status
Niet open voor verdere reacties.

Nieuwste berichten

Terug
Bovenaan Onderaan