Fout 13 tijde4ns uitvoering, omzeilen

[peter59]

Hallo,

Onderstaande code werkt perfect behalve als er in de pop-up op annuleren of op het kruisje wordt geklik.
Er volgt dan de code "Fout 13 tijdens uitvoering". Zie schermafbeeldingen.
De foutmelding had ik graag omzeilt dus deze melding niet tonen en macro gewoon afsluiten.
Zelf had ik al gezocht op b.v. "On Error ...... "
Maar ik kom er helaas niet uit. Wie kan en wil mij helpen?
Dank alvast.

Sub Copieer_Naar_Waarnemersform()

    Set Workrng = Application.Selection
    Set Workrng = Application.InputBox("Selecteer bereik", Workrng.Address, Type:=8)
    
    Workrng.Select
        Selection.Copy
    
    Workbooks.Open "C:\Users\peter\OneDrive\Bureaublad\Jos\TEST Waarnemers formulieren uit Tool.xlsx"
        Sheets("PQ-TblData").Select
            Range("A1048576").Select
                Selection.End(xlUp).Select
                    ActiveCell.Offset(1, 0).Select
                        Selection.PasteSpecial Paste:=xlPasteValues
                    
    Workbooks("TEST Waarnemers formulieren uit Tool.xlsx").Close SaveChanges:=True
        
   Range("A20").Select
        
End Sub

 

[AD1957]

kijk eens hier https://stackoverflow.com/questions/26264814/how-to-detect-if-user-select-cancel-inputbox-vba-excel
6 x Select in 11 coderegels ?

 

[AHulpje]

Probeer het eens zo:

Sub Copieer_Naar_Waarnemersform()
    Dim Workrng As Range
    Set Workrng = Application.Selection
    On Error GoTo errHandler
    Set Workrng = Application.InputBox("Selecteer bereik", Workrng.Address, Type:=8)
    Workrng.Copy
    Workbooks.Open "C:\Users\peter\OneDrive\Bureaublad\Jos\TEST Waarnemers formulieren uit Tool.xlsx"
    Sheets("PQ-TblData").Select
    Range("A1048576").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Workbooks("TEST Waarnemers formulieren uit Tool.xlsx").Close SaveChanges:=True
    Range("A20").Select
    Exit Sub
errHandler:
    If Err.Number = 424 Then
        MsgBox "Geen bereik geselecteerd"
    Else
        MsgBox Err.Description
    End If
End Sub

 

[snb]

Dat is het aardige van VBA:

Sub M_snb()
  Application.InputBox("Selecteer bereik", selection.Address, Type:=8).copy

  with getobject("C:\Users\peter\OneDrive\Bureaublad\Jos\TEST Waarnemers formulieren uit Tool.xlsx")
    .Sheets("PQ-TblData").cells(rows.count,1).end(xlup).offset(1).PasteSpecial -4163
    .close -1                
  end with        
End Sub

 

[peter59]

Hallo beste helpers

Ik ben helaas nu van de regen in de drup beland met het testen van jullie code.
Ik ben zo stom geweest om van het bestand waar de data heen gekopieerd moest worden, geen kopie van te maken.
M.a.w. het gehele bestand is niet meer bereikbaar. Ja, een mooi grijs vlak.
Ik kan op "Inschakelen" of "Uitschakelen" klikken wat ik wil maar, helaas.
Dus ik krijg de zondag wel om met het maken van een geheel nieuw bestand.

 

[snb]

M.a.w. het gehele bestand is niet meer bereikbaar. Ja, een mooi grijs vlak.

Kijk eens in het tabblad View/ optie Unhide

 

[peter59]

@Snb

Je bent een held.
Deze hint heeft mij uren aan "hobbyen" bespaart.
Ik kan nu, met dit weer even een terrasje gaan pikken.

Rest nog een vraagje. Hoe kan deze fout optreden?

 

[snb]

Dit is geen fout, maar een aardigheidje van GetObject, dat juist zo snel is omdat het de code in onzichtbare modus uitvoert, zodat er geen - trage- schermverversing nodig is.

indien gewenst gebruik je

Sub M_snb()
  Application.InputBox("Selecteer bereik", selection.Address, Type:=8).copy

  with getobject("C:\Users\peter\OneDrive\Bureaublad\Jos\TEST Waarnemers formulieren uit Tool.xlsx")
    .Sheets("PQ-TblData").cells(rows.count,1).end(xlup).offset(1).PasteSpecial -4163
    .windows(1).visible = true
    .close -1                
  end with        
End Sub

 

[AHulpje]

@snb
Mooie compacte code, maar je gaat er wel mee voorbij aan de wens van Peter om de foutmelding af te vangen die optreedt bij "Annuleren" of klikken op het kruisje van de Inputbox.
Ik heb daarvoor "On Error GoTo" gebruikt maar vraag mij af of er een betere methode is?

 

[peter59]

Hallo beste helpers

@AD1957
Dank voor de info maar helaas had dit geen betrekking op mijn vraag.
Dit werd ook al door AHulpje kenbaar gemaakt.

@AHulpje
Jij natuurlijk ook dank voor de hulp.
Jouw code werkt zoals ik het heb bedoelt.
Tevens is deze voor mij als leek zijnde toch nog "leesbaar".

@Snb
Natuurlijk ook dank voor je input.
Jouw code werkt nu zonder rare, grijze sheets e.d.
Maar mijn vraag is door de code van jou eigenlijk niet opgelost welke de code van AHulpje wel doet.
Je heb de opmerking van AD1957 ter harte genomen en heel goed opgelost oftewel de code behoorlijk ingekort.
De code is voor mij abracadabra oftewel veranderd er iets in de sheets e.d. dat weet ik absoluut niet waar ik het dien te zoeken.

Nogmaals bedankt voor jullie hulp, vooral op deze warme/hete zondag.

 

[snb]

Houd in je achterhoofd dat ik altijd suggesties voor een aanpak plaats, geen kant-en-klare oplossingen.
De finesses dienen door de vraagsteller opgelost te worden.

@Ahulp

Je zou hieraan kunnen denken:

Sub M_snb()
  On Error Resume Next
  Set snb = Application.InputBox("Selecteer bereik", , Selection.Address,,,,,8)

  If Err.Number = 0 Then
    snb.Copy
    with getobject("C:\Users\peter\OneDrive\Bureaublad\Jos\TEST Waarnemers formulieren uit Tool.xlsx")
      .Sheets("PQ-TblData").cells(rows.count,1).end(xlup).offset(1).PasteSpecial -4163
      .close -1                
    end with
  End If
End Sub

NB ik heb de huidige selectie als default ingesteld in de inputbox.

@peter

Speel eens met hide/unhide.
Met VBA wordt de gebruiker uitgeschakeld; daarom kan de verwerking in verborgen werkbladen en werkboeken plaatsvinden.
Dat verloopt vele malen sneller dan via het beeldscherm (screenupdating, calculation, volatiele formules/funkties, etc.)