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

Macro excel loopt niet meer in office 2007

Status
Niet open voor verdere reacties.
T

Tissue

Gebruiker
Lid geworden
19 jan 2010
Berichten
5
ik heb onderstaand een code van een macro staan die een collega gebruikt, echter is deze macro een lange tijd terug gemaakt door iemand die niet meer werkzaam is bij ons. Nu is het geval dat wij over zijn gegaan naar de nieuwe office (2007) en dat men deze macro niet meer kan draaien, echter heb ikzelf niet zoveel kaas gegeven van macro's dus vandaar dat ik de vraag hier neer leg. Wat ik er nog wel bij moet zeggen is dat de vorige versie 2003 een engelse versie was met een language pack erover heen en dat is met de nieuwe office 2007 niet zo. Moet ik dan nog iets aparts installeren op deze pc's? of ligt het puur aan de bouw van de Macro?

Code: 
Sub Starten_aanmaak_bericht_per_tab()
'
    DialogSheets("Dialoog1").Show
End Sub
Sub Aanmaken_bericht()
'
' Aanmaken bericht tbv maandafsluiting
' De macro is opgenomen op 31-1-2005 door TjacoN.
'
'Opslaan van file
    ActiveWorkbook.Save
'Scherm stilzetten
    Application.ScreenUpdating = True
'Sheet leegmaken
    Sheets("Totaaloverzicht tabbladen").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Sheets("Bericht").Select
    Range("A2:Z20000").Select
    Selection.Delete Shift:=xlUp
'BasisFormule kopieren
    Sheets("data").Select
    Range("A12:F12").Select
    Selection.Copy
    Sheets("Totaaloverzicht tabbladen").Select
    Range("K1").Select
    ActiveSheet.Paste
    Range("K2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=""BP""& LEFT(RC[-3], 1)&"" ""&LEFT(RC[-10],27)"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "=VALUE(RC[-10])"
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "=VALUE(RC[-10])"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=VALUE(RC[-10])"
    Range("O2").Select
    ActiveCell.FormulaR1C1 = "=abs(RC[-10]-RC[-9])"
    Range("P2").Select
    ActiveCell.FormulaR1C1 = "=IF((RC[-11]-RC[-10])<0,""C"",""D"")"
'Response instellen indien tabblad al geexporteerd
    Dim Msg3, Style3, Title3, Help3, Ctxt3, Response3, MyString3
    Msg3 = ("De sheet is reeds geexporteerd. Wil je dit nogmaals, dan dient de status omgezet te worden in het tabblad statussen, Cel E" & "keuze_welke_sheet" & ".")
    Style3 = vbOKOnly
    Title3 = "Exporteren"
'Sheet A kopieren
    If Range("statussen!E2") = "J" Then
    Response = MsgBox(Msg3, Style3, Title3, Help3, Ctxt3)
    Else
    Sheets("A").Select
    Range("A1:G997").Select
    Selection.Copy
    Sheets("Totaaloverzicht tabbladen").Select
    Range("A3").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H3").Select
    ActiveCell.FormulaR1C1 = "A"
    Selection.Copy
    Range("H4:H999").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    End If
'Sheet B kopieren
    If Range("statussen!E3") = "J" Then
    Response = MsgBox(Msg3, Style3, Title3, Help3, Ctxt3)
    Else
    Sheets("B").Select
    Range("A1:G999").Select
    Selection.Copy
    Sheets("Totaaloverzicht tabbladen").Select
    Range("A1000").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H1000").Select
    ActiveCell.FormulaR1C1 = "B"
    Selection.Copy
    Range("H1000:H1999").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    End If
'Sheet c1 kopieren
    If Range("statussen!E4") = "J" Then
    Response = MsgBox(Msg3, Style3, Title3, Help3, Ctxt3)
    Else
    Sheets("C1").Select
    Range("A1:G999").Select
    Selection.Copy
    Sheets("Totaaloverzicht tabbladen").Select
    Range("A2000").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H2000").Select
    ActiveCell.FormulaR1C1 = "C1"
    Selection.Copy
    Range("H2000:H2999").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    End If
'Sheet c2 kopieren
    If Range("statussen!E5") = "J" Then
    Response = MsgBox(Msg3, Style3, Title3, Help3, Ctxt3)
    Else
    Sheets("C2").Select
    Range("A1:G999").Select
    Selection.Copy
    Sheets("Totaaloverzicht tabbladen").Select
    Range("A3000").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H3000").Select
    ActiveCell.FormulaR1C1 = "C2"
    Selection.Copy
    Range("H3000:H3999").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    End If
'Sheet c3 kopieren
    If Range("statussen!E6") = "J" Then
    Response = MsgBox(Msg3, Style3, Title3, Help3, Ctxt3)
    Else
    Sheets("C3").Select
    Range("A1:G999").Select
    Selection.Copy
    Sheets("Totaaloverzicht tabbladen").Select
    Range("A4000").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H4000").Select
    ActiveCell.FormulaR1C1 = "C3"
    Selection.Copy
    Range("H4000:H4999").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    End If
'Sheet e kopieren
    If Range("statussen!E7") = "J" Then
    Response = MsgBox(Msg3, Style3, Title3, Help3, Ctxt3)
    Else
    Sheets("E").Select
    Range("A1:G999").Select
    Selection.Copy
    Sheets("Totaaloverzicht tabbladen").Select
    Range("A5000").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H5000").Select
    ActiveCell.FormulaR1C1 = "E"
    Selection.Copy
    Range("H5000:H5999").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    End If
'Sheet f kopieren
    If Range("statussen!E9") = "J" Then
    Response = MsgBox(Msg3, Style3, Title3, Help3, Ctxt3)
    Else
    Sheets("f").Select
    Range("A1:G999").Select
    Selection.Copy
    Sheets("Totaaloverzicht tabbladen").Select
    Range("A6000").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H6000").Select
    ActiveCell.FormulaR1C1 = "F"
    Selection.Copy
    Range("H6000:H6999").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    End If
'Sheet h kopieren
    If Range("statussen!E11") = "J" Then
    Response = MsgBox(Msg3, Style3, Title3, Help3, Ctxt3)
    Else
    Sheets("h").Select
    Range("A1:G999").Select
    Selection.Copy
    Sheets("Totaaloverzicht tabbladen").Select
    Range("A7000").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H7000").Select
    ActiveCell.FormulaR1C1 = "H"
    Selection.Copy
    Range("H7000:H7999").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    End If
'Sheet i kopieren
    If Range("statussen!E12") = "J" Then
    Response = MsgBox(Msg3, Style3, Title3, Help3, Ctxt3)
    Else
    Sheets("i").Select
    Range("A1:G999").Select
    Selection.Copy
    Sheets("Totaaloverzicht tabbladen").Select
    Range("A8000").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H8000").Select
    ActiveCell.FormulaR1C1 = "I"
    Selection.Copy
    Range("H8000:H8999").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    End If
'Sheet j kopieren
    If Range("statussen!E13") = "J" Then
    Response = MsgBox(Msg3, Style3, Title3, Help3, Ctxt3)
    Else
    Sheets("j").Select
    Range("A1:G999").Select
    Selection.Copy
    Sheets("Totaaloverzicht tabbladen").Select
    Range("A9000").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H9000").Select
    ActiveCell.FormulaR1C1 = "J"
    Selection.Copy
    Range("H9000:H9999").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    End If
'Sheet k kopieren
    If Range("statussen!E14") = "J" Then
    Response = MsgBox(Msg3, Style3, Title3, Help3, Ctxt3)
    Else
    Sheets("k").Select
    Range("A1:G999").Select
    Selection.Copy
    Sheets("Totaaloverzicht tabbladen").Select
    Range("A10000").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H10000").Select
    ActiveCell.FormulaR1C1 = "K"
    Selection.Copy
    Range("H10000:H10999").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    End If
'Sheet l kopieren
    If Range("statussen!E15") = "J" Then
    Response = MsgBox(Msg3, Style3, Title3, Help3, Ctxt3)
    Else
    Sheets("l").Select
    Range("A1:G999").Select
    Selection.Copy
    Sheets("Totaaloverzicht tabbladen").Select
    Range("A11000").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H11000").Select
    ActiveCell.FormulaR1C1 = "L"
    Selection.Copy
    Range("H11000:H11999").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    End If
'Sheet m kopieren
    If Range("statussen!E15") = "J" Then
    Response = MsgBox(Msg3, Style3, Title3, Help3, Ctxt3)
    Else
    Sheets("m").Select
    Range("A1:G999").Select
    Selection.Copy
    Sheets("Totaaloverzicht tabbladen").Select
    Range("A12000").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H12000").Select
    ActiveCell.FormulaR1C1 = "M"
    Selection.Copy
    Range("H12000:H12999").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    End If
'Sheet Sal kopieren
    If Range("statussen!E22") = "J" Then
    Response = MsgBox(Msg3, Style3, Title3, Help3, Ctxt3)
    Else
    Sheets("Sal").Select
    Range("A1:G999").Select
    Selection.Copy
    Sheets("Totaaloverzicht tabbladen").Select
    Range("A13000").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H13000").Select
    ActiveCell.FormulaR1C1 = "Sal"
    Selection.Copy
    Range("H13000:H13999").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    End If
'Toevoegen van formule tbv bericht
    Range("K2:P2").Select
    Selection.Copy
    Range("K5:K13999").Select
    ActiveSheet.Paste
'alle cellen plakken speciaal als waarden
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'nummering toevoegen tbv sortering bericht
    Range("i3").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C+1"
    Selection.Copy
    Range("i3:i13999").Select
    ActiveSheet.Paste
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'vervangen alle cellen met #waarde! door 0
    Range("K2:P13999").Select
    
    Cells.Select
    Selection.Replace What:="#WAARDE!", Replacement:="0", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
'verwijderen regels met nullen als bedrag
    Cells.Select
    Selection.AutoFilter
    Range("R1").Select
    Selection.AutoFilter Field:=15, Criteria1:="=0", Operator:=xlAnd
    Range("P2").Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range("A2:P15000").Select
    Selection.ClearContents
    Selection.AutoFilter
'sorteren op bedrag
Range("A4:P64891").Select
    Selection.Sort Key1:=Range("O5"), Order1:=xlAscending, Key2:=Range("L5") _
        , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
        , Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
        xlSortNormal
'teller invoeren
    Sheets("data").Select
    Range("B10").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNT('Totaaloverzicht tabbladen'!R[-5]C[10]:R[1147]C[10])"
'Sheet bericht leegmaken
    Sheets("bericht").Select
    Range("a3:O12999").Select
    Selection.Delete Shift:=xlUp
'Plakken nieuwe formules in bericht
    Sheets("bericht").Select
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "9"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=+data!R5C2"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=+data!R9C2"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "=+data!R8C2"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=+data!R6C2"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "=+data!R7C2"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=+'Totaaloverzicht tabbladen'!R[3]C[5]"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "=+'Totaaloverzicht tabbladen'!R[3]C[5]"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "=+'Totaaloverzicht tabbladen'!R[3]C[5]"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "=+'Totaaloverzicht tabbladen'!R[3]C[5]"
    Selection.NumberFormat = "0.00"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "=+'Data'!R4C2"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "=+'Totaaloverzicht tabbladen'!R[3]C[4]"
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "=+'Totaaloverzicht tabbladen'!R[3]C[-2]"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=+data!R1C2"
    Range("O2").Select
    ActiveCell.FormulaR1C1 = "=+data!R2C2"
    Selection.NumberFormat = "dd-mm-yyyy;@"
    Range("P2").Select
    ActiveCell.FormulaR1C1 = "00"
    Selection.NumberFormat = "General"
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "=+'Totaaloverzicht tabbladen'!R[3]C[-8]"
'Kopieren naar bericht
    Sheets("data").Select
    Max = Range("b10") + 1
    Sheets("bericht").Select
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Range("A2:Q" & Max).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
'Plakken waarden bericht
    Sheets("bericht").Select
    Range("A2:Q15000").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'Sorteren bericht op tabblad
    Sheets("bericht").Select
    Range("A1:Q15000").Select
    Selection.Sort Key1:=Range("Q5"), Order1:=xlAscending, Key2:=Range("Q5") _
        , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
        , Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
        xlSortNormal

'Scherm activeren
    Application.ScreenUpdating = True
'Bericht opslaan Ja/Nee
    Dim Msg1, Style1, Title1, Help1, Ctxt1, Response1, MyString1
    Msg1 = "Het bericht zal worden opgeslagen als csv-file. Doorgaan?"
    Style1 = vbYesNo
    Title1 = "Opslaan"
    Response = MsgBox(Msg1, Style1, Title1, Help1, Ctxt1)
       If Response = vbYes Then
         
    Sheets("Bericht").Select
    Cells.Select
    Selection.Copy
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("O2:O10000").Select
    Selection.NumberFormat = "dd-mm-yyyy;@"
    ChDir "\\nlibolt01\admini\"
    ActiveWorkbook.SaveAs Filename:="\\nlibolt01\admini\journaalpost.csv", FileFormat:= _
        xlCSV, CreateBackup:=False, local:=True
    ActiveWorkbook.Close SaveChanges:=False
    Dim Msg2, Style2, Title2, Help2, Ctxt2, Response2, MyString2
    Msg2 = "De website voor doorboeken kan nu geopend worden. Toets Hyperlink in cel B14. Op de webpagina svp knop 'Start Projectbookings' intoetsen. Hierna zal bestand als A... in FIS te zien zijn. Dit is overigens nog niet doorgeboekt, controle is nog mogelijk."
    Style2 = vbOKOnly
    Title2 = "Doorboeken FIS"
    Response = MsgBox(Msg2, Style2, Title2, Help2, Ctxt2)
    End If
 'Status op Ja zetten
    Range("statussen!E2") = "J"
    Range("statussen!E2").Copy
    Sheets("statussen").Select
    Range("E3:E22").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("data").Select
'Opslaan van file
    ActiveWorkbook.Save
    'Range("B15").Select
    'Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    '         ActiveWorkbook.SaveAs Filename:= _
 '            "\\nldigit01\extra\001\Production\Custom\Journal\journaalpost.csv", FileFormat _
  '           :=xlCSV, CreateBackup:=False
   ' Else


    
    
End Sub



Sub Aanmaken_bericht_per_tabblad()
'
' Aanmaken bericht tbv maandafsluiting
' De macro is opgenomen op 31-1-2005 door TjacoN.
'
'Opslaan van file
    ActiveWorkbook.Save
'Scherm stilzetten
    Application.ScreenUpdating = False
'Uitlezen status
    Sheets("statussen").Select
    keuze_welke_sheet = Range("statussen!G1") + 1
    geboekt_ja_nee = Range("E" & keuze_welke_sheet)
    If geboekt_ja_nee = "J" _
    Then
    Dim Msg, Style, Title, Help, Ctxt, Response, MyString
    Msg = ("De sheet is reeds geexporteerd. Wil je dit nogmaals, dan dient de status omgezet te worden in het tabblad statussen, Cel E" & keuze_welke_sheet & ".")
    Style = vbOKOnly
    Title = "Exporteren"
    Response = MsgBox(Msg, Style, Title, Help, Ctxt)
    Else
'Sheet leegmaken
    Sheets("Totaaloverzicht tabbladen").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Sheets("Bericht").Select
    Range("A2:Z20000").Select
    Selection.Delete Shift:=xlUp
'BasisFormule kopieren
    Sheets("data").Select
    Range("A12:F12").Select
    Selection.Copy
    Sheets("Totaaloverzicht tabbladen").Select
    Range("K1").Select
    ActiveSheet.Paste
    Range("K2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=""BP""& LEFT(RC[-3], 1)&"" ""&LEFT(RC[-10],27)"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "=VALUE(RC[-10])"
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "=VALUE(RC[-10])"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=VALUE(RC[-10])"
    Range("O2").Select
    ActiveCell.FormulaR1C1 = "=abs(RC[-10]-RC[-9])"
    Range("P2").Select
    ActiveCell.FormulaR1C1 = "=IF((RC[-11]-RC[-10])<0,""C"",""D"")"
'Gekozen sheet kopieren
    gekozen_sheet = Range("statussen!h1")
    Sheets(gekozen_sheet).Select
    Range("A1:G997").Select
    Selection.Copy
    Sheets("Totaaloverzicht tabbladen").Select
    Range("A3").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H3").Select
    ActiveCell.FormulaR1C1 = gekozen_sheet
    Selection.Copy
    Range("i3").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C+1"
    Range("H3:i3").Select
    Selection.Copy
    Range("H4:i999").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
'Toevoegen van formule tbv bericht
    Range("K2:P2").Select
    Selection.Copy
    Range("K5:K13999").Select
    ActiveSheet.Paste
'alle cellen plakken speciaal als waarden
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'vervangen alle cellen met #waarde! door 0
    Cells.Select
    Selection.Replace What:="#WAARDE!", Replacement:="0", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
'verwijderen regels met nullen als bedrag
    Cells.Select
    Selection.AutoFilter
    Range("R1").Select
    Selection.AutoFilter Field:=15, Criteria1:="=0", Operator:=xlAnd
    Range("P2").Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range("A2:P15000").Select
    Selection.ClearContents
    Selection.AutoFilter
'sorteren op bedrag
Range("A4:P64891").Select
    Selection.Sort Key1:=Range("O5"), Order1:=xlAscending, Key2:=Range("L5") _
        , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
        , Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
        xlSortNormal
'teller invoeren
    Sheets("data").Select
    Range("B10").Select
    ActiveCell.FormulaR1C1 = _
        "=COUNT('Totaaloverzicht tabbladen'!R[-5]C[10]:R[1147]C[10])"
'Sheet bericht leegmaken
    Sheets("bericht").Select
    Range("a3:O12999").Select
    Selection.Delete Shift:=xlUp
'Plakken nieuwe formules in bericht
    Sheets("bericht").Select
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "9"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=+data!R5C2"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=+data!R9C2"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "=+data!R8C2"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=+data!R6C2"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "=+data!R7C2"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=+'Totaaloverzicht tabbladen'!R[3]C[5]"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "=+'Totaaloverzicht tabbladen'!R[3]C[5]"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "=+'Totaaloverzicht tabbladen'!R[3]C[5]"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "=+'Totaaloverzicht tabbladen'!R[3]C[5]"
    Selection.NumberFormat = "0.00"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "=+'Data'!R4C2"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "=+'Totaaloverzicht tabbladen'!R[3]C[4]"
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "=+'Totaaloverzicht tabbladen'!R[3]C[-2]"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=+data!R1C2"
    Range("O2").Select
    ActiveCell.FormulaR1C1 = "=+data!R2C2"
    Selection.NumberFormat = "d/mm/yy;@"
    Range("P2").Select
    ActiveCell.FormulaR1C1 = "00"
    Selection.NumberFormat = "General"
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "=+'Totaaloverzicht tabbladen'!R[3]C[-8]" 'was -9
'Kopieren naar bericht
    Sheets("data").Select
    Max = Range("b10") + 1
    Sheets("bericht").Select
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Range("A2:Q" & Max).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
'Plakken waarden bericht
    Sheets("bericht").Select
    Range("A2:Q15000").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'Sorteren bericht op tabblad
    Sheets("bericht").Select
    Range("A1:Q15000").Select
    Selection.Sort Key1:=Range("Q5"), Order1:=xlAscending, Key2:=Range("Q5") _
        , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
        , Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
        xlSortNormal

'Scherm activeren
    Application.ScreenUpdating = True
'Bericht opslaan Ja/Nee
    Dim Msg1, Style1, Title1, Help1, Ctxt1, Response1, MyString1
    Msg1 = "Het bericht zal worden opgeslagen als csv-file. Doorgaan?"
    Style1 = vbYesNo
    Title1 = "Opslaan"
    Response = MsgBox(Msg1, Style1, Title1, Help1, Ctxt1)
       If Response = vbYes Then
    Application.ScreenUpdating = False
    Sheets("Bericht").Select
    Cells.Select
    Selection.Copy
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("O2:O10000").Select
    Selection.NumberFormat = "dd-mm-yyyy;@"
    ChDir "\\nlibolt01\admini\"
    ActiveWorkbook.SaveAs Filename:="\\nlibolt01\admini\journaalpost.csv", FileFormat:= _
        xlCSV, CreateBackup:=False, local:=True
    ActiveWorkbook.Close SaveChanges:=False
 'Status op Ja zetten
    Sheets("statussen").Select
    cel = Range("G1") + 1
    Range("E" & cel) = "J"
    Sheets("data").Select
    Application.ScreenUpdating = True
    Dim Msg2, Style2, Title2, Help2, Ctxt2, Response2, MyString2
    Msg2 = "De website voor doorboeken kan nu geopend worden. Toets Hyperlink in cel B16. Op de webpagina svp knop 'Start Projectbookings' intoetsen. Hierna zal bestand als A... in FIS te zien zijn. Dit is overigens nog niet doorgeboekt, controle is nog mogelijk."
    Style2 = vbOKOnly
    Title2 = "Doorboeken FIS"
    Response = MsgBox(Msg2, Style2, Title2, Help2, Ctxt2)
'Opslaan van file
    ActiveWorkbook.Save
    'Sheets("data").Select
    'Range("b14").Select
    'Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    
   ' Else

 End If
End If
    
    
End Sub
 
Wat ik zie is een ongelooflijk mooie verzameling van Select, Selection, Activecell, ActiveSheet enz...:p
Alle gekheid op een stokje, op welke regel draait de macro dan vast maw welke regel kleurt geel als je de macro probeert te draaien? Of welke foutmelding krijg je? Of gebeurt er helemaal niets?
 
Onderstaand word sub aanmaken_bericht_per tabblad geel gekleurd en dan word de eerste range blauw geselecteerd.


Code: 
Sub Aanmaken_bericht_per_tabblad()
'
' Aanmaken bericht tbv maandafsluiting
' De macro is opgenomen op 31-1-2005 door TjacoN.
'
'Opslaan van file
    ActiveWorkbook.Save
'Scherm stilzetten
    Application.ScreenUpdating = False
'Uitlezen status
    Sheets("statussen").Select
    keuze_welke_sheet = Range("statussen!G1") + 1
    geboekt_ja_nee = Range("E" & keuze_welke_sheet)
    If geboekt_ja_nee = "J" _
    Then
    Dim Msg, Style, Title, Help, Ctxt, Response, MyString
    Msg = ("De sheet is reeds geexporteerd. Wil je dit nogmaals, dan dient de status omgezet te worden in het tabblad statussen, Cel E" & keuze_welke_sheet & ".")
    Style = vbOKOnly
    Title = "Exporteren"
    Response = MsgBox(Msg, Style, Title, Help, Ctxt)
    Else
 
Bestaat werkblad statussen ?
 
Omdat je zelf niet zoveel kaas gegeten hebt van macro's is mijn advies: haal er gewoon iemand bij die dat voor jullie kan uitzoeken. Dit forum is meer geschikt voor mensen die er wel verstand van hebben of willen krijgen.
 
Wat is dit voor antwoord? dit is toch een helpmij forum en ik heb een probleem die ik opgelost wil hebben. Ik kan VB wel lezen alleen ik zie niet waar het fout gaat.

En ja er is een tabblad statussen waar hij naar kijkt.
 
je hebt gelijk, je moet juist alle vragen kunnen stellen.

maar ik heb nog een aanvullende vraag.
als die macro wel werkt in O. 2007, werkt ie dan ook nog in O. 2003? wij werken met verschillende versies.
 
Als er bovenaan je code Option Explicit staat ben je wel verplicht al je variabelen (alhoewel totaal overbodig) te declareren. Ik heb je code gereconstrueerd tot het punt Gekozen sheet kopieëren en dit leverde geen problemen op.
 
Als het goed en hij werkt in office 2003 zou hij ook moeten werken in office 2007. Bij ons zit het probleem waarschijnlijk in het feit dat wij bij office 2003 de dutch language pack erover heen hadden gezet en nu werken met de Nederlandse versie van office 2007. Maar ik kan niet zien waar het bij mij fout gaat en wat ik dan moet aanpassen of moet installeren.
 
Het eerste gedeelte gaat ook goed, maar het tweede gedeelte aanmaken_bericht_per_tabblad gaat het fout.
 
Het is van die code dat ik de reconstructie gemaakt heb en geen problemen gehad. Ik heb wel de code voor dat stuk herschreven (zonder overbodige variabelen en zonder al die Select, Selection, ActiveCell enz)
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan