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

Melding: Methode Range van object_Global is mislukt.

  • Onderwerp starter Onderwerp starter MMV
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.

MMV

Gebruiker
Lid geworden
6 mei 2008
Berichten
111
Ik heb bovenstaande code.
Nu loopt deze code vast op iets wat ik niet snap.

Het selecteren van kolommen om te verwijderen.
Weet iemand waarom?

Code:
Sub Actielijst_genereren()
'
' Actielijst_genereren Macro
' De macro is opgenomen op 07-05-2008 door Mark Vogels.
If MsgBox("Wilt u de actielijst genereren?", vbYesNo) = vbYes Then
'Copy Actielijst
    Dim WS As Worksheet
    Dim WSNew As Worksheet
    Dim rng As Range
    Dim rng2 As Range

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    UserForm2.Show 0
    
    DoEvents
  
    'Delete the sheet MyFilterResult if it exists
    'On Error Resume Next
    'Application.DisplayAlerts = False
    'Sheets("Copy Actionlist").Delete
    'Application.DisplayAlerts = True
    'On Error GoTo 0
    Sheets("Copy Actionlist").Select
    Cells.Select
    Selection.EntireColumn.Hidden = False
    Columns("A:AD").Select
    Selection.ClearContents
    

    'Add a new worksheet to copy the filter results in
    'Set WSNew = Worksheets.Add
    'WSNew.Name = "Copy Actionlist"
    'Sheets("Copy Actionlist").Move After:=Sheets("Actionlist")
    

    Sheets("Actionlist").Select
    Range("A1:AB10001").Select
    Selection.Copy
    Sheets("Copy Actionlist").Select
    Range("A1").Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
        Selection.PasteSpecial Paste:=xlPasteColumnWidths
    Application.CutCopyMode = False
            
    'link naar de meldingen op Sharepoint maken
    Columns("I:J").Select
    Selection.Insert Shift:=xlToRight

'kolom invoegen waarin hyperlink gestopt wordt
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "Hyperlink"
    Range("I2").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        "http://nlsv000134/sheq/_layouts/OSSSearchResults.aspx?k=Henkdetank&cs=Deze%20lijst&u=http%3A%2F%2Fnlsv000134%2Fsheq%2FLists%2FActieregister%20SCE"
    Range("I2").Copy
    Range("I3:I2001").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    Range("I:I").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    


    
'formule invoegen waarmee je de hyperlink maakt voor de melding op je actielijst
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "Referentie"
    Range("J2").FormulaLocal = "=HYPERLINK(VERVANGEN(I2;57;10;H2);H2)"
    Columns("J:J").Select
    Selection.NumberFormat = "General"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "=HYPERLINK(REPLACE(RC[-1],57,10,RC[-2]),RC[-2])"
    Range("J3").Select
    
    Range("J2").Copy
    Range("J3:J2001").PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=False
    
    Application.CutCopyMode = False
    
    
'opmaak zwart zodat er geen hyperlink te zien is
    Range("K1:O2001").Select
    Selection.Font.ColorIndex = 0
    Selection.Font.Underline = xlUnderlineStyleNone
    Application.CutCopyMode = False
    

    
    
'Overtollige kolommen verwijderen
    Range("A:A,C:C,E:E,F:F,N:N,T:T,V:V,W:W,X:X,AD:AD").Select
    Selection.Delete Shift:=xlToLeft
 
Laatst bewerkt door een moderator:
Vermijd select en activate in VBA: overbodig, vertragend en verwarrend.

bijv.
Code:
Columns("J:J").Select
    Selection.NumberFormat = "General"
kan beter met
Code:
sheets(1).columns(10).numberformat="General"
 
Laatst bewerkt:
Nou ik heb je advies opgevold, ik krijg nu alleen foutmelding op deze code, terwijl hij er in het begin wel overheen liep.

Code:
 Sheets("Copy Actionlist").Columns(5, 6, 11, 12, 13, 14, 15).Font.ColorIndex = 0
 
Ook dit werkt trouwens niet ;-)!

Code:
Sheets("Copy Actionlist").Columns("E:E,F:F,K:K,L:L,M:M,N:N,O:O").Font.ColorIndex = 0
 
Code:
   Sheets("Copy Actionlist").Range("A:F,K:O").Font.ColorIndex = 0
 
Dank je wel.

Het kan soms zo simpel zijn!
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan