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

Application.cutcopymode = false

Status
Niet open voor verdere reacties.

stefano

Gebruiker
Lid geworden
22 mei 2004
Berichten
860
In een macro worden data gekopieerd en geplakt. Ik stel vast dat die data op het klembord actief zijn/blijven. Ik gebruik nochthans hier en daar application.cutcopymode : false

Waarom wordt het klembord niet gewist?

- macro 1

Code:
Sub macro_vandaag()
    Call HM2("TOV", "Tarweontvangsten vandaag")
End Sub

-macro 2

Code:
Sub HM2(FN As String, NFN As String)
    Dim rijen As Integer

' 1. indien eindbestand open staat, afsluiten
    Dim Wb As Workbook
    On Error Resume Next
    Set Wb = Workbooks(NFN & ".xlsm")
    If Err.Number = 0 Then
        MsgBox "Bestand " & Wb.Name & " staat nog open, dit wordt afgesloten zonder opslaan"
        Wb.Close
    End If
' 1. einde afsluiten

    Application.DisplayAlerts = False
    Workbooks.OpenText Filename:="C:\data\sap\" & FN & "_1" & ".xls"
    Cells.Copy
    Application.Goto [A1]
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
[COLOR="#FF0000"]    Application.CutCopyMode = False[/COLOR]
    Columns("Y:IV").Select
    Selection.NumberFormat = "0.000"
    Application.Goto [A1]
    Application.Run "RIJENSAMENVOEGEN"
    Workbooks.Open Filename:="C:\data\sap\" & FN & "_2" & ".xlsm"
    Workbooks(FN & "_2" & ".xlsm").Activate
    rijen = Cells(Rows.Count, 1).End(xlUp).Row
    Rows("8" & ":" & rijen).Copy
    Range("A8").PasteSpecial xlPasteValues
[COLOR="#FF0000"]    Application.CutCopyMode = False[/COLOR]
    Application.Goto [A1]
    Workbooks(FN & "_2" & ".xlsm").SaveAs "C:\data\sap\" & NFN
    Workbooks(FN & "_1" & ".xls").Close False
    Application.DisplayAlerts = True
End Sub

in bovenstaande code wordt een derde macro opgeroepen (rijensamenvoegen)

Code:
Sub RIJENSAMENVOEGEN()
' error inbouwen wanneer er nog geen ontvangsten zijn
On Error GoTo Err1:
Dim i As Long, x As Long
Dim ii As Integer
Dim T1 As Variant
Const lSC As Long = 2  'regelnummer van de startcel
    T1 = Cells(lSC, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row - (lSC - 1), 256)
    ReDim T2(1 To 256, 1 To 1)
    For i = 1 To 256
        T2(i, 1) = T1(1, i)
    Next i
    x = 1
    For i = 2 To UBound(T1, 1)
        If T1(i, 1) = T1(i - 1, 1) Then
            For ii = 1 To 256
                If Replace(T1(i, ii), " ", "") <> "" Then T2(ii, x) = T1(i, ii)
            Next ii
        Else
            x = x + 1
            ReDim Preserve T2(1 To 256, 1 To x)
            For ii = 1 To 256
                T2(ii, x) = T1(i, ii)
            Next ii
        End If
    Next i
    With Sheets.Add(after:=Sheets(ActiveSheet.Index))
        With .Previous
            .Range("A1:IV1").Copy Cells(1, 1)
            .Cells.Copy
        End With
        .Cells.PasteSpecial xlPasteFormats
        .Cells(2, 1).Resize(UBound(T2, 2), 256) = WorksheetFunction.Transpose(T2)
        .Cells(1, 1).Select
    End With
[COLOR="#FF0000"]    Application.CutCopyMode = False[/COLOR]
Err1:
End Sub
 
Er zijn andere manieren om data om te zetten in waarden.

Waarom open je een .xls met de OpenText methode?
 
@hsv Ik krijg die zo aangeboden vanuit een extern programma. En neen, ik ben geen kenner he ;). Het is eigenlijk een .txt met een .xls bestandsnaam.

@Ed, ik mag dus niet alles geloven wat men op internet neerpent :p. Dit commando maakt dus enkel het selecteren ongedaan ...

Verder lees ik dat het gebruik van het clipboard beter zou vermijden ...

kan ik dan onderstaand door iets vervangen zonder clipboard te gebruiken?

Code:
    Cells.Copy
    Application.Goto [A1]
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
 
Het zal echt een gewoon Excel bestand zijn en geen platte tekst, anders kan je er nooit met VBA Excel objecten er op los en vallen er geen formules te verwijderen.
Dat is namelijk wat je code doet.
Er is niks mis met het gebruik van het Clipboard, het enige waarvoor men dat roept is omdat het geheugenruimte in beslag neemt.
Wat je code betreft bereik je hetzelfde met dit:
Code:
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value

Met Cells.Copy gebruik je het adres $1:$1048576
En dat neemt inderdaad nogal wat ruimte in het geheugen in beslag.
Met mijn voorbeeld gebeurt dat niet.
 
Laatst bewerkt:
Code vervangen, dit werkt , alhoewel het nu merkelijk trager gaat (max 5 sec).

dank !
 
Dat lijkt me vreemd, maar goed, als je het zo in orde vind is dat prima uiteraard.
 
Je hebt toch niet alleen Application.CutCopyMode = False vervangen door ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value hoop ik?
 
Ik heb er dit van gemaakt:

Code:
Sub HM2(FN As String, NFN As String) ' macro voor een plan met meerdere operaties (rijen samenvoegen)
    Dim rijen As Integer
' 1. indien eindbestand open staat, afsluiten
    Dim Wb As Workbook
    On Error Resume Next
    Set Wb = Workbooks(NFN & ".xlsm")
    If Err.Number = 0 Then
        MsgBox "Bestand " & Wb.Name & " staat nog open, dit wordt afgesloten zonder opslaan"
        Wb.Close
    End If
' 1. einde afsluiten
    Application.DisplayAlerts = False
    Workbooks.OpenText Filename:="C:\data\sap\" & FN & "_1" & ".xls"
[COLOR="#0000CD"]'    Cells.Copy
'    Application.Goto [A1]
'    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
'        :=False, Transpose:=False
'    Application.CutCopyMode = False[/COLOR]
  [COLOR="#FF0000"]  ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value[/COLOR]
[COLOR="#0000CD"]'    Columns("Y:IV").Select
'    Selection.NumberFormat = "0.000"[/COLOR]
[COLOR="#FF0000"]    Columns("Y:IV").NumberFormat = "0.000"[/COLOR]
'    Application.Goto [A1]
    Application.Run "RIJENSAMENVOEGEN"
    Workbooks.Open Filename:="C:\data\sap\" & FN & "_2" & ".xlsm"
    Workbooks(FN & "_2" & ".xlsm").Activate
    rijen = Cells(Rows.Count, 1).End(xlUp).Row
    Rows("8" & ":" & rijen).Copy
    Range("A8").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Application.Goto [A1]
    Workbooks(FN & "_2" & ".xlsm").SaveAs "C:\data\sap\" & NFN
    Workbooks(FN & "_1" & ".xls").Close False
    Application.DisplayAlerts = True
End Sub
 
Voor zover ik kan zien is die regel, en dus ook je eerdere stukje code, daar volledig overbodig.
Je opent daar een tekst bestand en dus zijn er geen formules die moeten worden omgezet naar waarden.
Daarnaast doe je iets verderop exact hetzelfde dat ook vervangen kan worden door een equivalent zonder .Copy
 
Laatst bewerkt:
ik weet niet hoe ik het kan vervangen . Kan je helpen?

Code:
Sub HM2(FN As String, NFN As String) ' macro voor een plan met meerdere operaties (rijen samenvoegen)
    Dim rijen As Integer
' 1. indien eindbestand open staat, afsluiten
    Dim Wb As Workbook
    On Error Resume Next
    Set Wb = Workbooks(NFN & ".xlsm")
    If Err.Number = 0 Then
        MsgBox "Bestand " & Wb.Name & " staat nog open, dit wordt afgesloten zonder opslaan"
        Wb.Close
    End If
' 1. einde afsluiten
    Application.DisplayAlerts = False
    Workbooks.OpenText Filename:="C:\data\sap\" & FN & "_1" & ".xls"
    Columns("Y:IV").NumberFormat = "0.000"
    Application.Run "RIJENSAMENVOEGEN"
    Workbooks.Open Filename:="C:\data\sap\" & FN & "_2" & ".xlsm"
    Workbooks(FN & "_2" & ".xlsm").Activate
    
[COLOR="#0000CD"]'hier bedoel je wellicht ?

    rijen = Cells(Rows.Count, 1).End(xlUp).Row
    Rows("8" & ":" & rijen).Copy
    Range("A8").PasteSpecial xlPasteValues
    [/COLOR]
    
    Application.CutCopyMode = False
    Application.Goto [A1]
    Workbooks(FN & "_2" & ".xlsm").SaveAs "C:\data\sap\" & NFN
    Workbooks(FN & "_1" & ".xls").Close False
    Application.DisplayAlerts = True
End Sub
 
Daar kan je ook gewoon dit gebruiken:
Code:
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
 
Pofferdorie, het lag voor het grijpen, maar ik durf zoiets niet makkelijk zelf te doen. Dank alvast


Code:
Sub HM2(FN As String, NFN As String) ' macro voor een plan met meerdere operaties (rijen samenvoegen)
' indien eindbestand open staat, afsluiten
    Dim Wb As Workbook
    On Error Resume Next
    Set Wb = Workbooks(NFN & ".xlsm")
    If Err.Number = 0 Then
        MsgBox "Bestand " & Wb.Name & " staat nog open, dit wordt afgesloten zonder opslaan"
        Wb.Close
    End If
' einde afsluiten
    Application.DisplayAlerts = False
    Workbooks.OpenText Filename:="C:\data\sap\" & FN & "_1" & ".xls"
    Columns("Y:IV").NumberFormat = "0.000"
    Application.Run "RIJENSAMENVOEGEN"
    Workbooks.Open Filename:="C:\data\sap\" & FN & "_2" & ".xlsm"
    Workbooks(FN & "_2" & ".xlsm").Activate
    ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
    Workbooks(FN & "_2" & ".xlsm").SaveAs "C:\data\sap\" & NFN
    Workbooks(FN & "_1" & ".xls").Close False
    Application.DisplayAlerts = True
End Sub
 
Ja en na gebruik door de eindgebruikers heb ik het door waarom ...

In het sheet mogen enkel rijen 8 tot en met de laatste rij gekopiëerd en geplakt worden en NIET de volledige range. In die eerste rijen staan formules subtotal die actief moeten blijven na het kopiëren en plakken. Dat was de reden voor het gebruik van onderstaande code.

Code:
    rijen = Cells(Rows.Count, 1).End(xlUp).Row
    Rows("8" & ":" & rijen).Copy
    Range("A8").PasteSpecial xlPasteValues

met onderstaande code zijn die formules dus weg ...

Code:
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
 
n hoe werkt dit:
Code:
ActiveSheet.UsedRange.Offset(8).Value = ActiveSheet.UsedRange.Offset(8).Value
?
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan