Werkblad export naar CVS minus regel 1

[tobi-wan]

Hoi,

Voor het bijhouden van een telefoonboek in een bedienpost van een telefooncentrale heb ik een CSV file nodig. Nou laat ik dat bijhouden door de klant in een excel file met daar in een button met een export en opslaan functie.

Om e.e.a. nou nog een beetje netter te maken heb ik eigenlijk 2 vragen:

• -Ik heb problemen met de eerste regel, zeg maar de header. Nou heb ik dat opgelost door op de eerste regel alleen opmerkingen te gebruiken. maar dat werkt niet echt lekker.
  Eigenlijk wil ik een export maken van de hele sheet minus regel 1.
• -ik wil de button eigenlijk ergens in een werkbalk plaatsen.

(zie bijgevoegde file)

Alvast bedankt voor de hulp,

Tobi

 

[snb]

Ik heb er deze macro van gemaakt:

Sub opslaan_csv()
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
    
  c0 = [gegevensblad!c2]
  ThisWorkbook.Sheets("csvphonebook").Copy
  With Workbooks(Workbooks.Count)
    .Sheets(1).UsedRange.Offset(1).Copy .Sheets(1).Range("A1")
    .SaveAs c0 & "phonebook.csv", xlCSV
    .Close
  End With
    
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

We wisten natuurlijk al dat Microsoft het niet zo nauw neemt met privacy van mensen en gegevens, maar hun eigen interne telefoonlijst op Internet zetten lijkt me wat overdreven. Suggestie: haal je bestand hier weg.

Een knop maken in de werkbalk doe je met :
cursor in menubalk/rechtermuisknop/aanpassen/macro

 

[tobi-wan]

Bedankt voor de snelle reactie. Het werkt.
Ook de knop op de werkbalk werkt.

Is het ook mogelijk om de bestaande opslaan knop uit te schakelen om daarmee de gebruiker te wingen om de macro te gebruiken

 

[snb]

Is niet nodig als je in deze gebeurtenisprocedure van het Excel bestand dezelfde code zet als ik eerder aanreikte.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

End Sub

Eigenlijk is die extra knop op de werkbalk dan niet nodig, want iedere keer als de gebruiker het bestand opslaat, wordt het bestand als csv-bestand weggeschreven.

 

[tobi-wan]

Dat snap ik niet, want ik heb toch nog steeds de knop met de macro nodig om op te slaan?
Als ik alleen het excel document save dan wordt er toch geen csv aangemaakt?

 

[snb]

Wel als je mijn suggestie gebruikt: beforesave vind plaats voordat het bestand wordt opgeslagen als het wordt opgeslagen.

 

[tobi-wan]

Ik heb de sub opslaan verwijderd en daar jou regel geplaatst met private sub.
Maar er gebeurt niets. hij slaat wel op maar maakt geen csv aan.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
    
  c0 = [gegevensblad!c2]
  ThisWorkbook.Sheets("csvphonebook").Copy
  With Workbooks(Workbooks.Count)
    .Sheets(1).UsedRange.Offset(1).Copy .Sheets(1).Range("A1")
    .SaveAs c0 & "phonebook.csv", xlCSV
    .Close
  End With
    
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

 

[snb]

Je moet die workbook_beforesave in de module ThisWorkbook zetten (VBEditor openen (Alt-F11), dubbelklik op Thisworkbook en daar de code plaatsen).

Zie bijlage

 

[tobi-wan]

Dat was de oplossing!! Weer een hoop geleerd vandaag.

Bedankt voor je hulp

 

[tobi-wan]

hoi ik wil mijn bovenstaande vraag uitbreiden met een 2e csv bestand

hoi ik wil mijn bovenstaande vraag uitbreiden met een 2e csv bestand met daarin alleen de kolommen met voornaam telefoonnummer en email-adres.

ik ben al aan de slag geweest met usedrange.columns maar daar kom ik niet verder mee.

 

[Mark xl]

Gebruikmakende van een deel de al beschikbare code van snb
Roep deze procedure aan dmv

call opslaan_csv2

in je bestaande thisworkbook_beforesave gebeurtenisprocedure

Sub Opslaan_csv2()
Dim lngRow As Long
Dim strPath As String
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    strPath = Sheets("gegevensblad").Range("C2")
    Sheets.Add    

    With Sheets("csvphonebook")
        lngRow = .Range("A2", .Range("A65535").End(xlUp)).Rows.Count
        Union(.Range("A2").Resize(lngRow), _
              .Range("B2").Resize(lngRow), _
              .Range("F2").Resize(lngRow)) _
            .Copy _
                Destination:=ActiveSheet.Range("A1")
    End With
    'naar nieuwe werkmap
    ActiveSheet.Move

    With Workbooks(Workbooks.Count)
        .SaveAs strPath & "phonebook2.csv", xlCSV
        .Close
    End With
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

wil je overigens ook de achternaam, dan zul je nog even

.Range("C2").Resize(lngRow), _

aan de union statement moeten toevoegen

gr,
Mark.

 

[tobi-wan]

Procedure aanroepen lukt nog niet

Mark,

Ik heb de code geplaatst, hij plaatst het automatisch in Algemeen, OpslaanCSV_2.

Ik kan het niet plaatsen in workbook beforesafe.

Doe ik iets verkeerd of moet ik nog iets doen om de code aan te roepen?Bekijk bijlage phonebook.xls

 

[Mark xl]

Beste Tobi,

Ik denk dat het werkt als je deze code in je thisworkbook module plakt
(vervang alle oude code)

succes.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
    
  c0 = [gegevensblad!c2]
  ThisWorkbook.Sheets("csvphonebook").Copy
  With Workbooks(Workbooks.Count)
    .Sheets(1).UsedRange.Offset(2, 1).Copy .Sheets(1).Range("A1")
    .SaveAs c0 & "phonebook.csv", xlCSV
    .Close
  End With
    
  'roep andere opslaan csv aan
  Call Opslaan_csv2

  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub

Sub Opslaan_csv2()
Dim lngRow As Long
Dim strPath As String
    
    strPath = Sheets("gegevensblad").Range("C2")
    Sheets.Add

    With Sheets("csvphonebook")
        lngRow = .Range("A2", .Range("A65535").End(xlUp)).Rows.Count
        Union(.Range("A2").Resize(lngRow), _
              .Range("B2").Resize(lngRow), _
              .Range("F2").Resize(lngRow)) _
            .Copy _
                Destination:=ActiveSheet.Range("A1")
    End With
    'naar nieuwe werkmap
    ActiveSheet.Move

    With Workbooks(Workbooks.Count)
        .SaveAs strPath & "phonebook2.csv", xlCSV
        .Close
    End With

End Sub

 

[tobi-wan]

Opgelost, ik snap nu ook hoe je een reeks met kolommen kan maken

Mark,

Alles werkt

Opgelost, Ik snap nu ook hoe je een reeks met kolommen kan maken.'
Weer wat geleerd. Bedankt voor de snelle service