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

Opslaan werkt niet.

Status
Niet open voor verdere reacties.
pd1lg

pd1lg

Gebruiker
Lid geworden
10 jun 2015
Berichten
86
Bekijk bijlage Federatie2017-3.xlsb

Het gaat om het onderstaande stukje vba. Op een of ander manier werkt het opslaan met de juiste bestandsnaam niet meer.
Het bestand moet opgeslagen worden met week nummer en -NBR3 2017. Maar dat doet het niet meer.
Willen jullie ff kijken? Ik moet de formule in een venster plaatsen, maar weet zo niet hoe dat moet. Sorry

Code: 
Option Explicit
Sub Print03_Click()
Dim j As Integer
Dim Destwb As Areas
Dim FileExtStr As Integer
Dim FileFormatNum As Integer
Dim TempFilePath As Integer
Dim TempFileName As String
Sheets("Database").Select

For j = 3 To 11
On Error Resume Next
Sheets("Database").Cells(j - 2, 1).Value = Sheets("Print03").Cells(j, 3).Value  'NAAM
Sheets("Database").Cells(j - 2, 2).Value = Sheets("Print03").Cells(j, 4).Value  'TC
Sheets("Database").Cells(j - 2, 3).Value = Sheets("Print03").Cells(j, 5).Value  'GC
Sheets("Database").Cells(j - 2, 4).Value = Sheets("Print03").Cells(j, 6).Value  'PTS
Sheets("Database").Cells(j - 2, 5).Value = "-"
Sheets("Database").Cells(j - 2, 6).Value = Sheets("Print03").Cells(j, 10).Value  'NAAM
Sheets("Database").Cells(j - 2, 7).Value = Sheets("Print03").Cells(j, 11).Value  'TC
Sheets("Database").Cells(j - 2, 8).Value = Sheets("Print03").Cells(j, 12).Value  'GC
Sheets("Database").Cells(j - 2, 9).Value = Sheets("Print03").Cells(j, 13).Value  'PTS

Next j
Sheets("Database").Cells(10, 3).Value = Sheets("Print03").Cells(12, 5).Value  'TOTAAL
Sheets("Database").Cells(10, 4).Value = Sheets("Print03").Cells(12, 6).Value  'NR
Sheets("Database").Cells(10, 7).Value = Sheets("Print03").Cells(12, 11).Value  'TOTAAL
Sheets("Database").Cells(10, 8).Value = Sheets("Print03").Cells(12, 12).Value  'NR

ActiveSheet.Copy
Set Destwb = ActiveWorkbook
    FileExtStr = ".xlsx": FileFormatNum = 51
    TempFilePath = "F:\Bert\Documents\NBR-BILJART\FEDERATIE 2017\NBR3\" De backslash staat er wel.Alleen hier niet.Sorry.
    TempFileName = ThisWorkbook.Sheets("Print03").Range("A2").Value & "-NBR3 2017" 'Week nummer + -NBR3 2017
    
    With Destwb
    .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
    .Close SaveChanges:=False
     End With
     
ActiveWorkbook.Close
Sheets("Database").Select
'Range("A1:KK20").ClearContents
End Sub
 
Laatst bewerkt:
En waar moet dat weeknummer vandaan komen?
Je kan het huidige weeknummer zo berekenen:
Code: 
    Dim WeekNummer as Integer
    Weeknummer = DatePart("ww", Date - Weekday(Date, 2) + 4, 2, 2)

    TempFileName = ThisWorkbook.Sheets("Print03").Range("A2").Value[COLOR="#FF0000"] & WeekNummer &[/COLOR] "-NBR3 2017"
 
Waarom noem je een bald 'database' als het geen database is?

Ipv alles in een lus weg te schrijven kan het ook zo
Code: 
Sub VenA()
  Union(Sheets("Print03").Range("C3:F12"), Sheets("Print03").Range("J3:L12")).Copy Sheets("Database").Cells(1)
End Sub
 
Dank je VenA, top van jouw. Waarom Database? Geen idee eigenlijk :D . Had het blad eerst ergens anders voor gebruikt.
 
Laatst bewerkt:
In plaats van

Code: 
For j = 3 To 11
 On Error Resume Next 
  Sheets("Database").Cells(j - 2, 1).Value = Sheets("Print03").Cells(j, 3).Value 'NAAM 
Sheets("Database").Cells(j - 2, 2).Value = Sheets("Print03").Cells(j, 4).Value 'TC 
Sheets("Database").Cells(j - 2, 3).Value = Sheets("Print03").Cells(j, 5).Value 'GC 
Sheets("Database").Cells(j - 2, 4).Value = Sheets("Print03").Cells(j, 6).Value 'PTS 
Sheets("Database").Cells(j - 2, 5).Value = "-" 
Sheets("Database").Cells(j - 2, 6).Value = Sheets("Print03").Cells(j, 10).Value 'NAAM 
Sheets("Database").Cells(j - 2, 7).Value = Sheets("Print03").Cells(j, 11).Value 'TC 
Sheets("Database").Cells(j - 2, 8).Value = Sheets("Print03").Cells(j, 12).Value 'GC 
Sheets("Database").Cells(j - 2, 9).Value = Sheets("Print03").Cells(j, 13).Value 'PTS
 Next j

volstaat:

Code: 
Sheets("Database").range("A14")=Sheets("Print03").range("C3:F6").value
Sheets("Database").range("A69")=Sheets("Print03").range("C10:F13").value

Zorg eerst voor een beter VBA-moyenne.
Dat opslaan is van later zorg.
 
Dank je voor de reactie snb. Wat bedoel je met 'Zorg eerst voor een beter VBA-moyenne' ?

Dat opslaan is van later zorg. Dit is voor mij wel belangrijk, omdat ik elke week de uitslagen naar een website moet uploaden. Dit doe ik door een bestand als 27-NBR3 2017.xlsx te maken.
Dit bestand kan ik dan uploaden in een wordpress website. zie www.nbrbiljart.nl
 
Dat opslaan staat al in #2, samen met een vraag.
 
Het weeknummer of wedstrijdnummer staat in Print03 A3.
Ik zie trouwens in #2 nergens iets van opslaan staan. Sorry
 
Met opslaan

Code: 
Sub VenA()
  Dim c00 As String
  c00 = "F:\Bert\Documents\NBR-BILJART\FEDERATIE 2017\NBR3\"
  Union(Sheets("Print03").Range("C3:F12"), Sheets("Print03").Range("J3:L12")).Copy Sheets("Database").Cells(1)
  Sheets("Database").Copy
  
  With ActiveWorkbook
    .SaveAs c00 & ThisWorkbook.Sheets("Print03").Range("A2").Value & "-NBR3 2017.xlsx"
    .Close 0
  End With
End Sub
 
In #2 reageerde ik over je opmerking m.b.t. een onjuiste bestandsnaam in #1.
 
Dank je wel VenA, snb en Edmoor.
Het werkt weer prima.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan