range van blad (uit sjabloon) kopieren en opslaan als

[bta]

Goedemiddag excellers,
Van bijgaand sjabloon wil ik van het blad "bestellijst" de range A1:F48 laten opslaan op O:\ als .xls met als het kan ook de datum en de usernaam. Daarna wil ik Excel laten afsluiten (met een kleine waarschuwing).
Ik heb lopen zoeken op het forum maar kom er niet uit.
Wellicht heeft een van jullie de oplossing?
Hartelijk dank voor de moeite. Gr. BTA
Bekijk bijlage 74911

 

[trucker10]

Beste BTA , net zoals vorige keer staat je bestandje beveiligd op het forum ,ook de xlt ( sjabloon uitvoering ) je moet het opslaan met de verwijzing naar die bepaalde cel ( range ) bv "[K6].Value & " " & [L6].Value & ".xls"" in de macro verwerken en een msgbox met een vbOkNo als controle .

 

[Warme bakkertje]

Anja, probeer deze eens. De macro start met knop 'bestellijst opslaan'

 

[bta]

Hoi Rudi,
Heel hartelijk dank.
Is het ook mogelijk om de layout te bewaren?
Groet, BTA

 

[Warme bakkertje]

Test volgende eens

 

[bta]

Ik krijg een foutmelding bij het opslaan:

Bekijk bijlage 75059

Wellicht doe ik iets fout??

 

[trucker10]

Ik krijg een foutmelding bij het opslaan:

Bekijk bijlage 75059

Wellicht doe ik iets fout??

Kijk bij de macro opslaan , Rudi heeft er D:/mijn doc ............. laten staan i.p.v. O:/............ waaar jij hem wil opslaan

 

[bta]

Ik probeer het nu thuis, dus alleen op D. Zie foutmelding.
Bekijk bijlage 75061

 

[trucker10]

Bij mij in de truck met excel 2002 der op geen probleem , kijk naar het backup bestandje ,

 

[bta]

Ik blijf de melding krijgen

 

[trucker10]

In excel 2007 krijg ik ook de foutmelding maar dan op de regel waar de dir staat voor het opslaan .

 

[snb]

Nu niet meer:

Sub opslaan()
  Thisworkbook.Sheets("bestellijst").Copy
  With ActiveWorkbook.Sheets(1).UsedRange
    .Value = .Value
    With .Parent
      For Each sh In .Shapes
        If sh.Type = 8 Then sh.Delete
      Next
      .SaveAs "D:\Mijn documenten\" & Format(Date, "dd-mm-yyyy ") & [F2].Value & ".xls"
      .Parent.Close False
    End With
  End With
End Sub

 

[trucker10]

snb :thumb: werkt bij mij in 2003 en 2007 zonder probleem , nu nog de testen van TS afwachten

 

[bta]

Helaas
Bekijk bijlage 75085

 

[Warme bakkertje]

Sub opslaan()
  ThisWorkbook.Sheets("bestellijst").Copy
  With ActiveWorkbook.Sheets(1).UsedRange
    .Value = .Value
    With .Parent
    [COLOR="Red"]Dim sh As Shape[/COLOR]
      For Each sh In .Shapes
        If sh.Type = 8 Then sh.Delete
      Next
      .SaveAs "O:\" & Format(Date, "dd-mm-yyyy ") & [F2].Value & ".xls"
      .Parent.Close False
    End With
  End With
End Sub

 

[bta]

Helaas
Bekijk bijlage 75091

 

[snb]

Verwijder option explicit uit je hele projekt.
Zorg dat het werkblad niet beveiligd is.

Sub opslaan()
  ThisWorkbook.Sheets("bestellijst").Copy
  With ActiveWorkbook.Sheets(1).UsedRange
    .parent.unprotect "bta"
    .Value = .Value
    With .Parent
      For Each sh In .Shapes
        If sh.Type = 8 Then sh.Delete
      Next
      .SaveAs "O:\" & Format(Date, "dd-mm-yyyy ") & [F2].Value & ".xls"
      .Parent.Close False
    End With
  End With
End Sub

nog een suggestie:

Sub maken()
  If MsgBox("Heb je alle door jou gewenste artikelen ingevuld?" & vbCrLf & vbCrLf & "Kan de bestellijst worden aangemaakt ?", vbYesNo + vbDefaultButton2, "Bestellijst maken") = vbNo Then Exit Sub
  Sheets("artikelen").Unprotect "bta"
  With Sheets("bestellijst")
    .Unprotect "bta"
    For Each cl In Sheets("artikelen").UsedRange.Columns(1).Offset(2).SpecialCells(2)
      .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 5) = cl.Resize(, 5).Value
    Next
    .Protect "bta"
  End With
  Sheets("artikelen").Protect "bta"
End Sub

 

[bta]

Dat is 'm :thumb:
Dankjewel