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

Veranderingen Excel 2013 tov 2010

Status
Niet open voor verdere reacties.
J

Jamara

Gebruiker
Lid geworden
15 aug 2008
Berichten
21
Ik heb een aantal macro's gemaakt in de versie 2010.
In versie 2013 reageren de instructies DirToSearch en FileToSearch niet en geven een compilatiefout.
Weet iemand hoe deze instructies in de versie 2013 heten?
 
Of, meer waarschijnlijk, functies. Het lijkt mij beter om het bestand mee te sturen.
 
Macro gemaakt in Excel2010, werkt niet in Excel2013

Onderstaand de macro die foutmelding geeft in Excel2013 oa op regel 10010110,10010112
en daardoor ook op regel 10010115.
Foutmelding op DirToSearch en FileToSearch
Kan daardoor macro ook niet verder testen op haar werking.
Weet iemand een oplossing hiervoor?

Sub bewerkjanafd01LJM()

' bewdeclovzgr Macro Versie 2.8
' De macro (2.6) is opgenomen op 26-08-2008 door jaap, aangepast dd
' 11 maart 2011 (2.7) en bewerkt een txt bestand met tussentellingen
' en pagina-opmaak.
' Gewijzigd op 30 december 2011 ivm overgang naar Office 2010 (2.8)


' Scherm onzichtbaar maken voor uitvoering macro
10010001 Application.ScreenUpdating = False

' Controleren of het bestand aanwezig is
10010110 DirToSearch = "O:\Oosterhout\Financieel\Declaratieoverzichten\01 januari\"
10010112 FileToSearch = "decloverz3101 afd 01L JM.txt"

10010115 If Not Dir(DirToSearch & FileToSearch) = vbNullString Then
10010116 MsgBox "Bestand decloverz3101 afd 01L JM.txt gevonden!! Bewerking wordt voltooid!!"
10010120 Else
10010121 MsgBox "Bestand decloverz3101 afd 01L JM.txt niet gevonden!! Bewerking wordt beëindigd!!"

'Afvinken van het bewerkte bestand
10010131 ActiveSheet.Unprotect
10010132 Range("H7").Font.ColorIndex = 46
10010134 ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

' Zichtbaar maken van het scherm
10010140 Application.ScreenUpdating = True
10010160 Exit Sub

' Einde controle aanwezigheid bestand
10010199 End If

' Opzoeken van het te bewerken txt bestand
10010200 ChDir "O:\Oosterhout\Financieel\Declaratieoverzichten\01 januari"
10010201 Workbooks.Open Filename:="decloverz3101 afd 01L JM.txt"
' Verwijderen van kolom A
10010210 Columns("A:A").Select
10010211 Selection.Delete Shift:=xlToLeft
' Kopieeren van de inhoud van cel A2 naar cel B2'
10010220 Range("A2").Select
10010221 Selection.Cut
10010222 Range("B2").Select
10010223 Selection.Font.Bold = True
' Verwijderen van kolom A ( 2e maal)
10010230 Columns("A:A").Select
10010231 Selection.Delete Shift:=xlToLeft
' Verwijderen van de inhoud van cel B1 t/m C1
10010240 Range("B1,C1,D1").Select
10010241 Selection.ClearContents
'Opmaken van cel B op benodigde breedte voor cel B.
10010250 Columns("B:B").EntireColumn.AutoFit
10010251 Range("B1").Select
10010252 Selection.Value = "Afdeling 01L"
10010253 Range("B1").Select
10010254 Selection.Font.Bold = True
'Verwijderen van kolom G t/m L uit oorspronkelijk txt bestand
10010260 Columns("G:M").Select
10010261 Selection.Delete Shift:=xlToLeft

'Ophalen van xls bestand om extra kolommen toe te voegen ter vervanging van
'de verwijderde kolommen G t/m L
10010300 Workbooks.Open Filename:="O:\Oosterhout\Financieel\Declaratieoverzichten\Extrakoldecladv.xlsx"
10010301 Range("G1:P3").Select
10010302 Selection.Copy
10010303 Windows("decloverz3101 afd 01L JM.txt").Activate
10010304 Range("G1").Select
10010305 Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
10010306 Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
10010307 Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
10010308 Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
10010309 Windows("Extrakoldecladv.xlsx").Activate
10010310 ActiveWindow.Close
10010311 Windows("decloverz3101 afd 01L JM.txt").Activate

' Opmaak van het gehele bestand naar lettertype Times New Roman puntgrootte 10
10010400 Cells.Select
10010401 With Selection.Font
10010402 .Name = "Times New Roman"
10010403 .Size = 10
10010404 End With

' Opmaak van de kolommen tot het einde van het bestand
10010500 Range("A4").Select
10010501 If Cells(4, 1).Value > 0 Then
10010502 Range("A3").Select
10010503 Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
10010504 Selection.Borders(xlDiagonalDown).LineStyle = xlNone
10010505 Selection.Borders(xlDiagonalUp).LineStyle = xlNone
10010506 With Selection.Borders(xlEdgeLeft)
10010507 .LineStyle = xlContinuous
10010508 .Weight = xlThin
10010509 .ColorIndex = xlAutomatic
10010510 End With
10010511 With Selection.Borders(xlEdgeTop)
10010512 .LineStyle = xlContinuous
10010513 .Weight = xlThin
10010514 .ColorIndex = xlAutomatic
10010515 End With
10010516 With Selection.Borders(xlEdgeBottom)
10010517 .LineStyle = xlContinuous
10010518 .Weight = xlThin
10010519 .ColorIndex = xlAutomatic
10010520 End With
10010521 With Selection.Borders(xlEdgeRight)
10010522 .LineStyle = xlContinuous
10010523 .Weight = xlThin
10010524 .ColorIndex = xlAutomatic
10010525 End With
10010526 With Selection.Borders(xlInsideVertical)
10010527 .LineStyle = xlContinuous
10010528 .Weight = xlThin
10010529 .ColorIndex = xlAutomatic
10010530 End With
10010531 With Selection.Borders(xlInsideHorizontal)
10010532 .LineStyle = xlContinuous
10010533 .Weight = xlThin
10010534 .ColorIndex = xlAutomatic
10010535 End With

10010599 Else
' Range("A3").Select
10010600 Range("A3:F3").Select
10010601 Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
10010602 Selection.Borders(xlDiagonalDown).LineStyle = xlNone
10010603 Selection.Borders(xlDiagonalUp).LineStyle = xlNone
10010604 With Selection.Borders(xlEdgeLeft)
10010605 .LineStyle = xlContinuous
10010606 .Weight = xlThin
10010607 .ColorIndex = xlAutomatic
10010608 End With
10010609 With Selection.Borders(xlEdgeTop)
10010610 .LineStyle = xlContinuous
10010611 .Weight = xlThin
10010612 .ColorIndex = xlAutomatic
10010613 End With
10010614 With Selection.Borders(xlEdgeBottom)
10010615 .LineStyle = xlContinuous
10010616 .Weight = xlThin
10010617 .ColorIndex = xlAutomatic
10010618 End With
10010619 With Selection.Borders(xlEdgeRight)
10010620 .LineStyle = xlContinuous
10010621 .Weight = xlThin
10010622 .ColorIndex = xlAutomatic
10010623 End With
10010624 With Selection.Borders(xlInsideVertical)
10010625 .LineStyle = xlContinuous
10010626 .Weight = xlThin
10010627 .ColorIndex = xlAutomatic
10010628 End With

10010699 End If


' Het kopieereen van de inhoud van cel G3 t/m P3 tot het einde van het bestand
10010700 Range("G3:P3").Select
10010701 Selection.Copy
10010702 Range("G4").Select
10010703 Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
10010704 ActiveSheet.Paste
10010705 Application.CutCopyMode = False

' Verbergen van de kolommen D E en F
10010710 Columns("D:F").Select
10010711 Selection.EntireColumn.Hidden = True

' pagina instelling titels boven aan elke pagina
10010720 With ActiveSheet.PageSetup
10010721 .PrintTitleRows = "$1:$2"
10010722 .PrintTitleColumns = ""
10010723 End With
10010724 ActiveSheet.PageSetup.PrintArea = ""
10010725 With ActiveSheet.PageSetup
10010726 .LeftHeader = ""
10010727 .CenterHeader = ""
10010728 .RightHeader = ""
10010729 .PrintHeadings = False
10010730 .Orientation = xlLandscape
10010731 .PaperSize = xlPaperA4
10010732 .Zoom = 77
10010733 End With

' Het invoegen van een totaal of tussentellingsregel op rij 49
' a het invoegen van een transportregel; er volgen nog 1 of meerdere bladen (Versie 2.4)

10010800 For blad = 49 To 770 Step 47 ' voor de To 770 kun je elk getal nemen met achtneming van elke keer een stap van 47
10010801 If Cells(blad, 1).Value > 0 Then
10010802 Range(Cells(blad, 1), Cells(blad + 1, 1)).EntireRow.Insert Shift:=xlDown
10010803 Cells(blad, 1).Value = "transporteren"
10010804 Range(Cells(blad, 1), Cells(blad, 2)).Select
10010805 With Selection
10010806 .HorizontalAlignment = xlCenter
10010807 .MergeCells = True
10010808 End With
10010809 Cells(blad + 1, 1).Value = "transport"
10010810 Range(Cells(blad + 1, 1), Cells(blad + 1, 2)).Select
10010811 With Selection
10010812 .HorizontalAlignment = xlCenter
10010813 .MergeCells = True
10010814 End With
10010815 Cells(blad, 7).FormulaR1C1 = "=SUBTOTAL(9,R[-47]C:R[-1]C)"
10010816 Cells(blad, 7).AutoFill Destination:=Range(Cells(blad, 7), Cells(blad, 14)), Type:=xlFillDefault
10010817 Cells(blad, 14).Copy Cells(blad, 16)
10010818 Cells(blad + 1, 7).FormulaR1C1 = "=R[-1]C"
10010819 Cells(blad + 1, 7).AutoFill Destination:=Range(Cells(blad + 1, 7), Cells(blad + 1, 16)), Type:=xlFillDefault
10010820 Cells(blad + 1, 15).ClearContents

' b het invoegen van een totaalregel; er volgen geen bladen meer
10010850 Else: Cells(blad, 1).Value = "totaal"
10010851 Range(Cells(blad, 1), Cells(blad, 2)).Select
10010852 With Selection
10010853 .HorizontalAlignment = xlCenter
10010854 .MergeCells = True
10010855 End With
10010856 Cells(blad, 7).FormulaR1C1 = "=SUBTOTAL(9,R[-47]C:R[-1]C)"
10010857 Cells(blad, 7).AutoFill Destination:=Range(Cells(blad, 7), Cells(blad, 14)), Type:=xlFillDefault
10010858 Cells(blad, 14).Copy Cells(blad, 16)

' Opmaak van totaalcel kolom a en b
10010900 Cells(blad, 1).Select
10010901 Selection.Borders(xlDiagonalDown).LineStyle = xlNone
10010902 Selection.Borders(xlDiagonalUp).LineStyle = xlNone
10010903 With Selection.Borders(xlEdgeLeft)
10010904 .LineStyle = xlContinuous
10010905 .Weight = xlThin
10010906 .ColorIndex = xlAutomatic
10010907 End With
10010908 With Selection.Borders(xlEdgeTop)
10010909 .LineStyle = xlContinuous
10010910 .Weight = xlThin
10010911 .ColorIndex = xlAutomatic
10010912 End With
10010913 With Selection.Borders(xlEdgeBottom)
10010914 .LineStyle = xlContinuous
10010915 .Weight = xlThin
10010916 .ColorIndex = xlAutomatic
10010917 End With
10010918 With Selection.Borders(xlEdgeRight)
10010919 .LineStyle = xlContinuous
10010920 .Weight = xlThin
10010921 .ColorIndex = xlAutomatic
10010922 End With

' Strepen en vakjes in laaste regel (=totaalregel)
10010950 Range(Cells(blad, 7), Cells(blad, 16)).Select
10010951 Selection.Borders(xlDiagonalDown).LineStyle = xlNone
10010952 Selection.Borders(xlDiagonalUp).LineStyle = xlNone
10010953 With Selection.Borders(xlEdgeLeft)
10010954 .LineStyle = xlContinuous
10010955 .Weight = xlThin
10010956 .ColorIndex = xlAutomatic
10010957 End With
10010958 With Selection.Borders(xlEdgeTop)
10010959 .LineStyle = xlContinuous
10010960 .Weight = xlThin
10010961 .ColorIndex = xlAutomatic
10010962 End With
10010963 With Selection.Borders(xlEdgeRight)
10010964 .LineStyle = xlContinuous
10010965 .Weight = xlThin
10010966 .ColorIndex = xlAutomatic
10010967 End With
10010968 With Selection.Borders(xlInsideVertical)
10010969 .LineStyle = xlContinuous
10010970 .Weight = xlThin
10010971 .ColorIndex = xlAutomatic
10010972 End With
10010973 With Selection.Borders(xlEdgeBottom)
10010974 .LineStyle = xlDouble
10010975 '.Weight = xlThin
10010976 .ColorIndex = xlAutomatic
10010977 End With

10011000 Selection.NumberFormat = "#,##0.00"


' Verwijderen van lege regels
10011050 Range(Cells(blad - 47, 1), Cells(blad - 1, 1)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

' Beëndiging van de if for
10011100 If Cells(blad + 1, 1).Value = 0 Then Exit For
'Gedeelte voor het door laten zoeken van de pagina's voordat laatste pagina gevonden is
10011150 End If
10011151 Next blad

' Opslaan van het bewerkte bestand en terugkeren naar maandblad
10011200 ActiveWorkbook.SaveAs Filename:= _
"O:\Oosterhout\Financieel\Declaratieoverzichten\01 januari\decloverz3101 afd 01L JM.xlsx", FileFormat:=xlOpenXMLWorkbook _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
10011201 ActiveWorkbook.Close
10011202 MsgBox "Bewerking afd 01L JM is afgesloten"

' Afvinken van het bewerkte bestand
10011250 ActiveSheet.Unprotect
10011251 Range("H7").Select
10011252 Selection.Font.ColorIndex = 10
10011253 ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

' Zichtbaar maken van het scherm
10011300 Application.ScreenUpdating = True

End Sub
 
Plaats svp de code tussen codetags.

Waarschijnlijk staat er boven de geplaatste code Option Explicit. Je moet dan de variabelen declareren.

Dus wordt het begin zoiets

Code: 
Sub VenA()

Dim DirToSearch As String
Dim FileToSearch As String

Application.ScreenUpdating = False
DirToSearch = "O:\Oosterhout\Financieel\Declaratieoverzichten\01 januari\"
FileToSearch = "decloverz3101 afd 01L JM.txt"
If Not Dir(DirToSearch & FileToSearch) = vbNullString Then
    MsgBox "Bestand decloverz3101 afd 01L JM.txt gevonden!! Bewerking wordt voltooid!!"
  Else
    MsgBox "Bestand decloverz3101 afd 01L JM.txt niet gevonden!! Bewerking wordt beëindigd!!"
End If
End Sub
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan