Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Option Explicit
- Sub Nummerserie()
- ' Nummerserie makro
- ' Denne makro indsætter en nummerserie i den markerede celle, hvor du selv kan vælge dit sidste/største nummer
- Dim i As Integer
- Dim sidstetal As Integer
- sidstetal = InputBox("skriv det sidste nummer", "Nummerseire")
- For i = 1 To sidstetal
- ActiveCell.Select
- ActiveCell.Value = i
- ActiveCell.Offset(1, 0).Select
- Next i
- End Sub
- Sub Gem_som_PDF()
- ' Import Makro
- ' Denne makro gemmer de to ark, der ikke er start, som PDF-filer.
- Dim StrFilNavn As String
- With Application.FileDialog(msoFileDialogFolderPicker)
- .Show
- StrFilNavn = .SelectedItems(1)
- End With
- For Each Worksheet In Worksheets
- If Worksheet.Name <> "Start" Then
- Worksheet.ExportAsFixedFormat Type:=xlTypePDF, _
- FileName:=StrFilNavn & "\" & Worksheet.Name & ".pdf", _
- Quality:=xlQualityStandard, _
- IncludeDocProperties:=True, _
- IgnorePrintAreas:=False, _
- OpenAfterPublish:=True
- End If
- Next Worksheet
- End Sub
- Sub Str_Diagrammer()
- ' Str_Diagrammer Makro
- ' Denne makro ordner alle diagrammer så de er 200x300
- Sheets("Diagram").Select
- ActiveSheet.ChartObjects.Width = 300
- ActiveSheet.ChartObjects.Height = 200
- Range("A1").Select
- End Sub
- Sub Import_CVS_fil()
- ' Import_CVS_fil Macro
- ' Denne makro er beregnet til at indlæse et dokument og tilføre det til data-arket.
- ' Variable
- Dim strFil As String
- Dim strAktivCelle As String
- Dim FilNr As Byte
- Dim LinjeElementer() As String
- ' Fil nummer
- FilNr = FreeFile 'Næste ledige fil nummer
- ' Hastighed til
- With Application
- .ScreenUpdating = False
- .Calculation = xlCalculationManual
- End With
- ' Find den celle data skal ind i
- Sheets("Data").Select
- If Range("A2").Value = "" Then
- Range("A2").Select
- Else
- Range("A2").Select
- Selection.End(xlDown).Select
- Range("A" & ActiveCell.Row + 1).Select
- End If
- ' Valg fil
- With Application.FileDialog(msoFileDialogFilePicker)
- .Title = "Vælg den fil du vil importere"
- .Filters.Clear
- .Filters.Add "CSV Filer", "*.csv"
- .AllowMultiSelect = False
- .Show
- ' Check om der er valgt nogle filer
- If .SelectedItems.Count = 0 Then
- Exit Sub
- End If
- strFil = .SelectedItems(1)
- End With
- ' Import fil
- Open strFil For Input Access Read As #FilNr
- 'Gennemløb af filen
- Do Until EOF(FilNr)
- Line Input #FilNr, strFil
- LinjeElementer = Split(strFil, ";")
- ' CustomerID
- ActiveCell.Value = LinjeElementer(0)
- ' OrderID
- ActiveCell.Offset(0, 1).Value = LinjeElementer(1)
- ' OrderDate
- ActiveCell.Offset(0, 2).Value = CDate(LinjeElementer(2))
- ' ProduktID
- ActiveCell.Offset(0, 3).Value = CDbl(LinjeElementer(3))
- ' Unitprice
- ActiveCell.Offset(0, 4).Value = LinjeElementer(4)
- ' Quantity
- ActiveCell.Offset(0, 5).Value = LinjeElementer(5)
- ' Gå en Row ned
- ActiveCell.Offset(1, 0).Select
- Loop
- Close FilNr ' Lukker filen
- ' Hastighed fra
- With Application
- .ScreenUpdating = True
- .Calculation = xlCalculationAutomatic
- End With
- 'Ganger stk og pris til en total.
- Sheets("Data").Select
- Range("A2").Select
- Do Until ActiveCell.Value = ""
- ActiveCell.Offset(0, 6).Formula = "=E" & ActiveCell.Row & "*F" & ActiveCell.Row
- ActiveCell.Offset(1, 0).Select
- Loop
- Sheets("Data").Select
- Range("A1").Select
- End Sub
- Sub Marts()
- 'marts Makro
- 'Denne makro er designet til at markere samtlige ordre fortaget i marts måned.
- Sheets("Data").Select
- Range("C2").Select
- Do Until ActiveCell.Value = ""
- If Month(ActiveCell.Value) = 3 Then
- With ActiveCell
- .Interior.Color = vbBlue
- .Font.Bold = True
- .Font.Color = vbWhite
- End With
- End If
- ActiveCell.Offset(1, 0).Select
- Loop
- Range("A1").Select
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement