Hjälp med Excel makro - matplanering

[a-son]

Sist i VBA scriptet har jag lagt till en export funktion

funkar skapligt,

får 2 problem:

 

1. vore bra om filen redan finns så ska den raderas

2. den gör tomma rader där det inte finns text pga av att formeln är i dom cellerna med antar jag.

 

Har inte tid med det här just nu känner jag, men kul är det!

 

~$Meal_Planner_131031_lunch.zip

[a-son]

använde mej av Kill "filnamn.txt" i scriptet

så nu tar den bort filen innan ny skapas,

 

så det är det alla blanka rader som ska bort och "åäö" funkar inte som det ska heller

[a-son]

Hittade nytt script som funkar med åäö

gjorde en ny knapp för export till fil

 

nu är det alla blank raderna kvar,

finns det något annat sätt att skapa det som är på export fliken?

för om jag får in endast det data som är där så blir det inga blank rader på slutet

~$Meal_Planner_131031_lunch.zip

[Monshi]

Tja, du får räkna antalet rader du ska exportera...

 

Antingen kopiera bara den del av sidan eller fixa till tabellen så att den inte är längre än behövs.

 

Som alltid finns det flera vägar till samma mål.

 

Kanske lägga på ett filter på din exporttabell, kopiera detta till en ny bok/sida som du exporterar.

Eller räkna antalet rader med innehåll och kopiera/klistra in.

[a-son]

Jag är helt grön på sånt här, så det är lite krångligt att fatta hur tänket är.

 

om jag fattar det rätt så kan jag göra ungefär så här:

först räkna antal rader i shopping listan

med hjälp av det värdet så ska jag köra min formel på det antalet rader

resultat ska sedan visas på en ny flik.

 

då gäller det bara att hitta rätt kommandon för det här nu då...

[Monshi]

Finns flera sätt att lösa det på men det är inte fel det du tänker dig.

 

men

Sub Export()
    Application.ScreenUpdating = False
    On Error Resume Next
    Dim wb As Workbook
    Set wb = Workbooks.Add
    Dim rnSource As Range
    Set rnSource = Blad1.Range("A1")
    rnSource.Resize(Sheet4.PivotTables(1).RowRange.Rows.Count, 1).Copy
    Dim rnTarget As Range
    Set rnTarget = wb.Sheets(1).Cells(1, 1)
    rnTarget.PasteSpecial xlPasteValues
    
    wb.SaveAs Filename:="file1.txt", FileFormat:=xlTextMSDOS
    wb.Close False
    Application.ScreenUpdating = True
End Sub

Exempelvis.

 

 

[a-son]

Tackar, det här är ju roligt!

 

Körde din nu, och då blir det 2 tomma rader, och åäö problemet kvarstår

ska titta lite på koden och se om jag förstår mej på den.

 

 

så här är den som åäö funkar men ger många tomma rader

 

Sub Export()

' Skapa export fil för import till http://www.ourgroceries.com/your-lists/

'   Change file name to suit

    Const FileName As String = "ourgroceries.txt"

    Dim FileNo As Integer

    Dim x As Long

    FileNo = FreeFile

    Open FileName For Output As #FileNo

'   Change sheet reference to suit

    With Worksheets("Export")

        For x = 1 To .Range("A1:A" & .Range("A65536").End(xlUp).Row).Count

            Print #FileNo, .Cells(x, 1).Value

        Next x

    End With

    Close #FileNo

End Sub

[Monshi]

Okej, i den där koden kan du enkelt kolla vilka rader som har data och bara adressera dessa.

 

Du kan ta raden som räknar rader i Pivot (och om den har en viss offsett, fixa det) och sätta din exportrange med hjälp av denna.

[a-son]

Hittade ett fel på koden du postade, ändrade till FileFormat:=xlUnicodeText

så nu funkar åäö

 

ett problem kvarstår, det blir ett par vagnsretur (enter) för mycket i text filen tyvärr

 

 

Kan man enkelt spara det i urklipp också?

skulle nästa gå lika forta att ladda upp det på hemsidan genom att klipp och klistra.

 

Har flyttat datum hanteringen för att generera shopping listan till calculations!D25 kan dom vara där eller kan det bli en krock?

Meal_Planner_131031_kväll.zip

[a-son]

Hittat ett fel,

på rad 2 är det potatis som side dish, när man tittar på calcutations så tror den att det är potatismos hemlagad.

 

Utanför mina kunskaps områden just nu..

Meal_Planner_131101_fm.zip

[Monshi]

Okej, två ändringar då

När ingredienslistan skapas, ändra rad 47 i module1 till

[WeekIngredients_tempCriteria].Offset(1).Resize(1) = "=""=" & vDishes(c, 2) & """"

 

I exporten ändra till

 rnSource.Resize(Sheet4.PivotTables(1).RowRange.Rows.Count - 1, 1).Copy

 

Så ska de två problemen vara ur världen.

 

[a-son]

tackar funkar fint,

 

vad gör den skillnaden?

 

[WeekIngredients_tempCriteria].Offset(1).Resize(1) = vDishes(c, 2)

[WeekIngredients_tempCriteria].Offset(1).Resize(1) = "=""=" & vDishes(c, 2) & """"

[Monshi]

Att det står

="=Potatis"

i cellen när avancerade filtret kör ger att enbart en exakt träff filtreras ut.

 

Du kan testa själv med att applicera ett avancerat filter manuellt på en tabell och se hur de fungerar.

[a-son]

Ja får göra det, det här var ju roligt att pyssla med.

 

Frågade om det här med, vad tror du:

Har flyttat datum hanteringen för att generera shopping listan till calculations!D25 kan dom vara där eller kan det bli en krock?

 

och importen av text filen funkar inte just nu, det är fel på ourgroceries sida, får fel meddelande  har mailat dom ang det.

 

Ska klura lite på att kopiera texten till urklippet under tiden,

går lika fort att få in varorna i appen på det viset

[Monshi]

Där du lagt dem (datumlistorna) ligger de inte i vägen för något.

 

Exporten i sig, den ser ut som den ska nu? Inga extra tecken som stör eller så?

[a-son]

ja den ser rätt ut

tar jag klipp och klistra från txt filen till ett formulär på sidan funkar det...

 

har även testat med en vara och utan antal men det blir error iallafall.

så dom har nog något galet där.

[a-son]

Där du lagt dem (datumlistorna) ligger de inte i vägen för något.

 

Exporten i sig, den ser ut som den ska nu? Inga extra tecken som stör eller så?

 

Exporten var i fel format fick jag som svar,

ska vara UTF-8, gjorde om exporten till CSV

wb.SaveAs FileName:="c:\temp\file1.csv", FileFormat:=xlCSV

 

då gick det att importera där, men åäö blev konstiga tecken, får jobba vidare med det senare.

 

 

Jobbar med en HTML export, men det är något fel,

den gör ny bok som ser ok ut, men när den ska spara den så blir det fel, och boken stängs inte.

När jag aktiverar första raden istället "range" så funkar det.

    'Range("b6:d15").Select
    'ActiveWorkbook.Sheets("meal plan").Copy
    ActiveWorkbook.Sheets("meal plan").Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    ActiveWorkbook.SaveAs FileName:="C:\Temp\test\main.html", _
    FileFormat:=xlHtml, CreateBackup:=False
    Application.DisplayAlerts = False
    ActiveWorkbook.Close
    Application.DisplayAlerts = True 

   

[Monshi]

Om du ska exportera till HTML finns det bättre metoder än att spara bok/sida som HTML.

 

Börja med att skapa en tom HTML-sida i valfri editor, bara en siddefinition.

I Excel starta inspelning av ett makro och markera den tabell/det område du vill exportera. Eller så tar vi hela bladet om du så vill.

Välj Spara som, filformat HTML och välj markering (eller sida).

Klicka sedan publicera och leta reda på din tomma HTML-sida och publicera den.

Stoppa sedan makrot.

Där har du en bra grund, i princip bara att köra detta makro igen och den tabell som skrivits till HTML-sidan skrivs över. Övrig text, om du har någon, på sidan rörs inte.

 

Export, filformat.

Din kod

Sub Export()

' Skapa export fil för import till http://www.ourgrocer...com/your-lists/
'   Change file name to suit
    Const FileName As String = "ourgroceries.txt"
    Dim FileNo As Integer
    Dim x As Long
    FileNo = FreeFile
    Open FileName For Output As #FileNo
'   Change sheet reference to suit
    With Worksheets("Export")
        For x = 1 To .Range("A1:A" & .Range("A65536").End(xlUp).Row).Count
            Print #FileNo, .Cells(x, 1).Value
        Next x
    End With
    Close #FileNo
End Sub

Fungerar? Den blir rätt?

Bara ändra raden

For x = 1 To .Range("A1:A" & .Range("A65536").End(xlUp).Row).Count

till

For x = 1 To .Range("A1").Offset(Sheet4.PivotTables(1).RowRange.Rows.Count - 2)

så borde den ta rätt område. Tror -2 är rätt, ändra annars.

[a-son]

Ska testa med makro inspelning.

 

den exporten funkar också att importera, men åäö blir konstiga tecken

 

din rad funkar däremot inte,

For x = 1 To .Range("A1").Offset(Sheet4.PivotTables(1).RowRange.Rows.Count - 2)

[Monshi]

Okej, då går vi tillbaka till min kod...

 

eller ja som du vill

Testa att lägg in

ActiveWorkbook.WebOptions.Encoding = msoEncodingUTF8

i Export-rutinen, innan export sker.

och spara i lämpligt format, textformat borde vara rätt.

 

Hoppas det fungerar med ÅÄÖ

[Monshi]

eller läs

http://answers.microsoft.com/en-us/office/forum/office_2013_release-excel/how-can-i-save-a-csv-with-utf-8-encoding-using/12801501-c1e4-4a64-80d9-96b680b64cfe

om det är CSV du behöver.

[a-son]

Har nu testat flera macron för export, och kört macron för att konvertera till UTF-8 etc.

men ingen ser bra ut på ourgroceries hemsida,

ska redogöra för vilka sätt jag testat ikväll.

väntar även svar från dom om en fil som jag skickat över som ska vara utf-8

kanske ska släppa det där och försöka få över listan till urklipp istället och klistra in.

 

Spelade in ett makro för att spara som html, blir riktigt bra,

ett problem som jag ser är att jag sparar som, och inte spara en kopia som.

får kanske göra ett marko som sparar ett orginal innan spara som html eller nåt

[a-son]

Har löst Save as html så här:

Sub SaveAs_HTML()
    Application.ScreenUpdating = False
'Spara bok för att kunna öppna igen senare
    Dim MyFullName As String
    MyFullName = ActiveWorkbook.FullName
    ActiveWorkbook.Save
    
'Delete all files and subfolders
'Be sure that no file is open in the folder
    Dim FSO As Object
    Dim MyPath As String
    Set FSO = CreateObject("scripting.filesystemobject")
    MyPath = "C:\Temp\WWW"  '<< Change
    If Right(MyPath, 1) = "\" Then
        MyPath = Left(MyPath, Len(MyPath) - 1)
    End If
    If FSO.FolderExists(MyPath) = False Then
        MsgBox MyPath & " doesn't exist"
        Exit Sub
    End If
    On Error Resume Next
    'Delete files
    FSO.deletefile MyPath & "\*.*", True
    'Delete subfolders
    FSO.deletefolder MyPath & "\*.*", True
    On Error GoTo 0

'Spara bok som hemsida
    ActiveWorkbook.SaveAs FileName:= _
        "C:\Temp\WWW\main.htm", FileFormat:=xlHtml, _
        ReadOnlyRecommended:=False, CreateBackup:=False
            
'Öppna tidigare sparad bok
    Workbooks.Open FileName:= _
        MyFullName ', UpdateLinks:=False

'Stäng excel med hemsida
    Workbooks("main.htm").Close SaveChanges:=False

    Application.ScreenUpdating = True
End Sub

Har tyvärr fått några externa referenser (länkar) måste ha blivit när jag labbat och kopierat mellan olika böcker,

hittade ett par i en flik som jag testat lite i men det kvarstår, har sökt i hela arbetsboken efter [ dock hittar jag inga fler fel

 

 

Lite funderingar, när man har ett macro som funkar bra, så kan man anropa det från ett annat macro med Call

och för att få nytta av det så vill man inte ha absoluta sökvägar i sub macrot för att enkelt kunna återanvända koden.

så då hade jag hoppats på att det skulle gå att sätta dom parametrarna före anropet, men det funkar tydligen inte så, finns det någon lösning eller ska man ge upp?

 

Sub SaveAs_HTML()

 

'Anrop av macro för radera filer och kataloger

Dim MyPath As String

MyPath = "C:\Temp\WWW\"

Call Delete_FileFolder

 

'Spara bok som hemsida

    ActiveWorkbook.SaveAs FileName:= _

        "C:\Temp\WWW\main.htm", FileFormat:=xlHtml, _

        ReadOnlyRecommended:=False, CreateBackup:=False

 

End sub

 

Meal_Planner_AKT.zip

[a-son]

Skulle återkomma med vilka export jag gjort,

har testat dessa

Sub Export()



' Skapa export fil för import till http://www.ourgrocer...com/your-lists/
'   Change file name to suit
    Const FileName As String = "C:\Temp\ourgroceries.txt"
    Dim FileNo As Integer
    Dim x As Long
    FileNo = FreeFile
    Open FileName For Output As #FileNo
'   Change sheet reference to suit
    With Worksheets("Export")
'        For x = 1 To .Range("A1").Offset(Sheet4.PivotTables(1).RowRange.Rows.Count - 2)
       For x = 1 To .Range("A1:A" & .Range("A65536").End(xlUp).Row).Count
            Print #FileNo, .Cells(x, 1).Value
        Next x
    End With
    Close #FileNo
End Sub

 

 

Sub export_2()

    Application.ScreenUpdating = False


' Raderar file1.txt om den redan finns
Dim KillFile As String
KillFile = "c:\temp\file1.txt"
'KillFile = "c:\temp\file1.csv"
'Check that file exists
If Len(Dir$(KillFile)) > 0 Then
    'First remove readonly attribute, if set
    SetAttr KillFile, vbNormal
    'Then delete the file
     Kill KillFile
End If
    'Monchi's tips!
    On Error Resume Next
Dim wb As Workbook
    Set wb = Workbooks.Add
    Dim rnSource As Range
    Set rnSource = Blad1.Range("A1")
    rnSource.Resize(Sheet4.PivotTables(1).RowRange.Rows.Count - 1, 1).Copy
    Dim rnTarget As Range
    Set rnTarget = wb.Sheets(1).Cells(1, 1)
    rnTarget.PasteSpecial xlPasteValues
    'ActiveWorkbook.WebOptions.Encoding = msoEncodingUTF8
    'wb.SaveAs FileName:="c:\temp\file1.txt", FileFormat:=xlUnicodeText
    'wb.SaveAs FileName:="c:\temp\file1.csv", FileFormat:=xlCSV
    wb.SaveAs FileName:="c:\temp\file1.txt", FileFormat:=xlTextMSDOS
    wb.Close False
    Application.ScreenUpdating = True


' Öppnar hemsidan när allt är klart
' Const Hyper As String = "http://www.ourgroceries.com/your-lists/"
' ThisWorkbook.FollowHyperlink Address:=Hyper ', NewWindow:=True


End Sub

 

och på den här sista macrot har jag testat alla FileFormat som har anknyting till CSV eller dos eller windows som jag hittade på den här sidan:

http://msdn.microsoft.com/en-us/library/office/ff841185.aspx

 

 

 

sedan så har jag testat att köra igenom ett få tal filer genom dom här 2 macrona, 

 

Sub SaveAsUTF8() 

     
    Dim fsT, tFileToOpen, tFileToSave As String 
     
    tFileToOpen = "c:\temp\ourgroceries.txt"
    tFileToSave = "c:\temp\ourgroceries_UTF8.txt"
     
    tFileToOpenPath = tFileToOpen 
    tFileToSavePath = tFileToSave 
     
Set fsT = CreateObject("ADODB.Stream"): 'Create Stream object
fsT.Type = 2: 'Specify stream type – we want To save text/string data.
fsT.Charset = "utf-8": 'Specify charset For the source text data.
     
fsT.Open: 'Open the stream
fsT.LoadFromFile tFileToOpenPath: 'And write the file to the object stream
     
fsT.SaveToFile tFileToSavePath, 2: 'Save the data to the named path
     
End Sub 

 

 

Sub Encode()

Const CSVPath As String = "c:\temp\ourgroceries.txt" '<<< change path
With CreateObject("ADODB.Stream")
.Type = 2
.Open
.LoadFromFile CSVPath
.Charset = "UTF-8"
.SaveToFile CSVPath, 2
.Close
End With


End Sub

 

 

och det har inte blivit någon fil som funkat att importera.

 

[Monshi]

Länkar, finns några bland de namngivna referenserna, bland namnen. Städa lite där.

 

Spara som HTML, vad vill du spara?

Hela boken eller bara en tabell? Om bara en tabell fungerar kod som denna kort utmärkt:

 With ActiveWorkbook.PublishObjects.Add(xlSourceRange, _
        "D:\Excel\TubTest.html", "Blad1", "$A$1:$D$10", _
        xlHtmlStatic, "Bok1_5047", "")
        .Publish (False)
        .AutoRepublish = False
  End With

Ser du texten Bok1_5047? Det är ett ID på din export. Nästa gång du kör samma export kommer den skriva över det som finns inom denna tag i HTML-filen.

Du kan även få boken att automatisk publicera områden/blad när boken sparas. Behövs ingen kod för det.

 

Smidigt.

Spara/exportera flera sidor till samma sida/flera sidor? Kör bara fler som den ovan.

Busenkelt, snabbt och effektivt.

Lite stökig HTML-kod givetvis, det är ju Excel vi använder.

 

 

UTF8 och Excel är tydligen problematiskt. Excel stöder inte UTF8 i CSV utan man måste gå runt det. Exakt hur vet jag inte, jag måste testa precis som du gör.

 

 

Anropa annan kod?

Ett enkelt exempel

Sub MyMsgBox(text As String)
    MsgBox text, vbInformation, "Information"

End Sub


Sub Test1()
    MyMsgBox Gen1(True) & " " & Gen2(True)
    
    MyMsgBox Gen1(False) & " " & Gen2(False)
End Sub

Function Gen1(bl As Boolean) As String
    If bl Then
        Gen1 = "Hello"
    Else
        Gen1 = "Goodbye"
    End If
End Function

Det jag vill visa är att skicka argument..

Absoluta sökvägar?

Du kan få fram bokens sökväg, där den är sparad, med

ThisWorkbook.Path