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

Timer

Status
Niet open voor verdere reacties.
S

SUVERMO

Gebruiker
Lid geworden
22 dec 2019
Berichten
481
beste,

onderstaande vraag heeft betrekking op de excel gepost in https://www.helpmij.nl/forum/showth...te-aanpassen?p=6213109&viewfull=1#post6213109
Is het mogelijk om in cel “UITLEG M17” en in cel “INZENDERSLIJST BU15” een timer te laten zien.
Deze zou moeten starten als er een macro begint en stoppen als de verwerking is gebeurt. Als alle berekeningen zijn afgelopen zou in deze cellen de duur van het verwerken moeten verschijnen.
 
Zorg dat de codes op orde zijn.

Alle 'select, selected en activate' eruit.
Gebruik 'application.screenupdate = false' tegen flikkeren van het beeld.

Wat je nu wil zorgt alleen maar voor meer vertraging.
 
Eens HSV, maar soms duurt het dan toch nog lang en is het beter om de gebruiker (af en toe) te informeren wat de voortgang is.
 
HSV zei:
Zorg dat de codes op orde zijn.

Alle 'select, selected en activate' eruit.
Gebruik 'application.screenupdate = false' tegen flikkeren van het beeld.

Wat je nu wil zorgt alleen maar voor meer vertraging.
Klik om te vergroten...
mag in deze code
Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("TITTEL")) Is Nothing Then
  Sheets("UITLEG").Select
  Cancel = True
End If
End Sub
".Select" dan weg
Code: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("TITTEL")) Is Nothing Then
  Sheets("UITLEG")
  Cancel = True
End If
End Sub
 
heb juist geprobeerd om in onderstaande


Code: 
Sub Inzenderslijst_maken()
'
' Inzenderslijst_maken Macro
'

'
If Right(ThisWorkbook.Name, 19) = "_Inzenderslijst.xls" Then
    Call Inzenderslijst_wijzigen
    Exit Sub
End If

If Range("LETTER").Value = "" Then
    Exit Sub
End If

Application.ScreenUpdating = False
    Rem BEGIN VAN TELLERS
    TEL1 = Range("OPENNAAM").Value
    TEL2 = Range("SLUITNAAM").Value
    TEL3 = Range("BESTANDSNAAM").Value
    TEL4 = Range("BEWAARNAAM").Value
    Rem TEL5 = Range("KOPIEERNAAM").Value staat verderop
Rem EIND VAN TELLERS
    ActiveSheet.Unprotect
    Range("InzenderslijstHidden").EntireRow.Hidden = True
    Rows("25").Hidden = False
    Sheets("INPUT").Visible = True
    Sheets("INZENDERSLIJST").Visible = True
    Sheets("INZENDERSLIJST").Select
    Sheets("UITLEG").Select
    Range("BESTANDSNAAM").Select
    Workbooks.Open Filename:=TEL1
    Windows(TEL3).Activate
    Sheets("INPUT").Select
    Rows("3:65536").Select
    Windows(TEL2).Activate
    Cells.Select
    Selection.Copy
    Windows(TEL3).Activate
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("INZENDERSLIJST").Select
    ActiveWindow.SmallScroll Down:=-3
    Rows("18:18").Select
    Selection.Copy
    TEL5 = Range("KOPIEERNAAM").Value
    Range(TEL5).Select
    ActiveSheet.Paste
    Sheets("INZENDERSLIJST").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True
    Windows(TEL2).Activate
    ActiveWindow.Close
    Sheets("UITLEG").Select
    ActiveSheet.Unprotect
    Range("LETTER").Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    Range("OPENMAP").Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    Range("BEWAARMAP").Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    Range("B3").Activate
    Columns("L:L").Select
    Selection.EntireColumn.Hidden = True
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlUnlockedCells
    Sheets("INZENDERSLIJST").Select
    ActiveSheet.Unprotect
    VALIDATIE = Range("VALIDATIE").Value
    ActiveSheet.Range(VALIDATIE).AutoFilter Field:=71, Criteria1:=Array( _
        "0", "1", "4", "="), Operator:=xlFilterValues
    Range("BO9").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:= _
        True, AllowFormattingColumns:=True, AllowFormattingRows:=True
    Sheets("INPUT").Select
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("UITLEG").Select
    ActiveWindow.SelectedSheets.Visible = False
    Application.ScreenUpdating = True
    ActiveWorkbook.SaveAs Filename:= _
        TEL4, FileFormat:=xlExcel8, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
Application.ScreenUpdating = True
Calculate
End Sub

alle ".Select" te verwijderen, maar ik krijg dan foutmelding,

Code: 
Sub Inzenderslijst_maken()
'
' Inzenderslijst_maken Macro
'

'
If Right(ThisWorkbook.Name, 19) = "_Inzenderslijst.xls" Then
    Call Inzenderslijst_wijzigen
    Exit Sub
End If

If Range("LETTER").Value = "" Then
    Exit Sub
End If

Application.ScreenUpdating = False
    Rem BEGIN VAN TELLERS
    TEL1 = Range("OPENNAAM").Value
    TEL2 = Range("SLUITNAAM").Value
    TEL3 = Range("BESTANDSNAAM").Value
    TEL4 = Range("BEWAARNAAM").Value
    Rem TEL5 = Range("KOPIEERNAAM").Value staat verderop
Rem EIND VAN TELLERS
    ActiveSheet.Unprotect
    Range("InzenderslijstHidden").EntireRow.Hidden = True
    Rows("25").Hidden = False
    Sheets("INPUT").Visible = True
    Sheets("INZENDERSLIJST").Visible = True
    Sheets("INZENDERSLIJST")
    Sheets("UITLEG")
    Range("BESTANDSNAAM")
    Workbooks.Open Filename:=TEL1
    Windows(TEL3).Activate
    Sheets("INPUT")
    Rows("3:65536")
    Windows(TEL2).Activate
    Cells
    Selection.Copy
    Windows(TEL3).Activate
    Range("A1")
    ActiveSheet.Paste
    Sheets("INZENDERSLIJST")
    ActiveWindow.SmallScroll Down:=-3
    Rows("18:18")
    Selection.Copy
    TEL5 = Range("KOPIEERNAAM").Value
    Range(TEL5)
    ActiveSheet.Paste
    Sheets("INZENDERSLIJST")
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True
    Windows(TEL2).Activate
    ActiveWindow.Close
    Sheets("UITLEG")
    ActiveSheet.Unprotect
    Range("LETTER")
    Selection.Locked = True
    Selection.FormulaHidden = False
    Range("OPENMAP")
    Selection.Locked = True
    Selection.FormulaHidden = False
    Range("BEWAARMAP")
    Selection.Locked = True
    Selection.FormulaHidden = False
    Range("B3").Activate
    Columns("L:L")
    Selection.EntireColumn.Hidden = True
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlUnlockedCells
    Sheets("INZENDERSLIJST")
    ActiveSheet.Unprotect
    VALIDATIE = Range("VALIDATIE").Value
    ActiveSheet.Range(VALIDATIE).AutoFilter Field:=71, Criteria1:=Array( _
        "0", "1", "4", "="), Operator:=xlFilterValues
    Range("BO9")
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:= _
        True, AllowFormattingColumns:=True, AllowFormattingRows:=True
    Sheets("INPUT")
    ActiveWindowedSheets.Visible = False
    Sheets("UITLEG")
    ActiveWindowedSheets.Visible = False
    Application.ScreenUpdating = True
    ActiveWorkbook.SaveAs Filename:= _
        TEL4, FileFormat:=xlExcel8, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
Application.ScreenUpdating = True
Calculate
End Sub

wat doe ik fout?
 

Bijlagen

  • foutmelding.jpg
    foutmelding.jpg
    109 KB · Weergaven: 43
Ik ga je hele procedure niet nalopen, maar onderstaande kan je vervangen (want ik heb geen flauw idee wat er allemaal in de cellen staat van TEL1,TEL2, enz.).......
Code: 
Range("LETTER").Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    Range("OPENMAP").Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    Range("BEWAARMAP").Select
    Selection.Locked = True
    Selection.FormulaHidden = False

....door.
Code: 
with Range("LETTER")
    .Locked = True
    .FormulaHidden = False
end with
with Range("OPENMAP")
        .Locked = True
       .FormulaHidden = False
end with
with Range("BEWAARMAP")
       .Locked = True
      .FormulaHidden = False
end with

Of:
Code: 
sv = array("LETTERS","OPENMAP","BEWAARMAP")
for i = 0 to 2
 with Range(sv(i))
       .Locked = True
      .FormulaHidden = False
end with
next i

EN als de 'Locked' op deze cellen al handmatig op True zijn gezet en je de beveiliging eraf en er weer opzet, is het al helemaal overbodig en kan het er wel uit.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan