Advertisement
Guest User

Untitled

a guest
Apr 25th, 2019
164
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 4.31 KB | None | 0 0
  1. Option Explicit
  2.  
  3.  
  4. Sub Nummerserie()
  5. ' Nummerserie makro
  6. ' Denne makro indsætter en nummerserie i den markerede celle, hvor du selv kan vælge dit sidste/største nummer
  7.  
  8. Dim i As Integer
  9. Dim sidstetal As Integer
  10.  
  11. sidstetal = InputBox("skriv det sidste nummer", "Nummerseire")
  12.  
  13. For i = 1 To sidstetal
  14. ActiveCell.Select
  15. ActiveCell.Value = i
  16. ActiveCell.Offset(1, 0).Select
  17. Next i
  18.  
  19. End Sub
  20.  
  21.  
  22. Sub Gem_som_PDF()
  23. ' Import Makro
  24. ' Denne makro gemmer de to ark, der ikke er start, som PDF-filer.
  25.  
  26. Dim StrFilNavn As String
  27.  
  28.  
  29. With Application.FileDialog(msoFileDialogFolderPicker)
  30. .Show
  31. StrFilNavn = .SelectedItems(1)
  32. End With
  33.  
  34. For Each Worksheet In Worksheets
  35. If Worksheet.Name <> "Start" Then
  36.  
  37. Worksheet.ExportAsFixedFormat Type:=xlTypePDF, _
  38. FileName:=StrFilNavn & "\" & Worksheet.Name & ".pdf", _
  39. Quality:=xlQualityStandard, _
  40. IncludeDocProperties:=True, _
  41. IgnorePrintAreas:=False, _
  42. OpenAfterPublish:=True
  43. End If
  44. Next Worksheet
  45.  
  46. End Sub
  47.  
  48.  
  49. Sub Str_Diagrammer()
  50. ' Str_Diagrammer Makro
  51. ' Denne makro ordner alle diagrammer så de er 200x300
  52.  
  53. Sheets("Diagram").Select
  54. ActiveSheet.ChartObjects.Width = 300
  55. ActiveSheet.ChartObjects.Height = 200
  56.  
  57. Range("A1").Select
  58.  
  59. End Sub
  60.  
  61.  
  62. Sub Import_CVS_fil()
  63. ' Import_CVS_fil Macro
  64. ' Denne makro er beregnet til at indlæse et dokument og tilføre det til data-arket.
  65.  
  66. ' Variable
  67. Dim strFil As String
  68. Dim strAktivCelle As String
  69. Dim FilNr As Byte
  70. Dim LinjeElementer() As String
  71.  
  72. ' Fil nummer
  73. FilNr = FreeFile 'Næste ledige fil nummer
  74.  
  75. ' Hastighed til
  76. With Application
  77. .ScreenUpdating = False
  78. .Calculation = xlCalculationManual
  79. End With
  80.  
  81. ' Find den celle data skal ind i
  82. Sheets("Data").Select
  83. If Range("A2").Value = "" Then
  84. Range("A2").Select
  85. Else
  86. Range("A2").Select
  87. Selection.End(xlDown).Select
  88. Range("A" & ActiveCell.Row + 1).Select
  89. End If
  90.  
  91. ' Valg fil
  92. With Application.FileDialog(msoFileDialogFilePicker)
  93. .Title = "Vælg den fil du vil importere"
  94. .Filters.Clear
  95. .Filters.Add "CSV Filer", "*.csv"
  96. .AllowMultiSelect = False
  97. .Show
  98.  
  99. ' Check om der er valgt nogle filer
  100. If .SelectedItems.Count = 0 Then
  101. Exit Sub
  102. End If
  103.  
  104. strFil = .SelectedItems(1)
  105. End With
  106.  
  107. ' Import fil
  108. Open strFil For Input Access Read As #FilNr
  109.  
  110. 'Gennemløb af filen
  111. Do Until EOF(FilNr)
  112. Line Input #FilNr, strFil
  113. LinjeElementer = Split(strFil, ";")
  114. ' CustomerID
  115. ActiveCell.Value = LinjeElementer(0)
  116. ' OrderID
  117. ActiveCell.Offset(0, 1).Value = LinjeElementer(1)
  118. ' OrderDate
  119. ActiveCell.Offset(0, 2).Value = CDate(LinjeElementer(2))
  120. ' ProduktID
  121. ActiveCell.Offset(0, 3).Value = CDbl(LinjeElementer(3))
  122. ' Unitprice
  123. ActiveCell.Offset(0, 4).Value = LinjeElementer(4)
  124. ' Quantity
  125. ActiveCell.Offset(0, 5).Value = LinjeElementer(5)
  126. ' Gå en Row ned
  127. ActiveCell.Offset(1, 0).Select
  128. Loop
  129.  
  130. Close FilNr ' Lukker filen
  131.  
  132. ' Hastighed fra
  133. With Application
  134. .ScreenUpdating = True
  135. .Calculation = xlCalculationAutomatic
  136. End With
  137.  
  138. 'Ganger stk og pris til en total.
  139. Sheets("Data").Select
  140. Range("A2").Select
  141.  
  142.  
  143. Do Until ActiveCell.Value = ""
  144. ActiveCell.Offset(0, 6).Formula = "=E" & ActiveCell.Row & "*F" & ActiveCell.Row
  145. ActiveCell.Offset(1, 0).Select
  146. Loop
  147.  
  148.  
  149. Sheets("Data").Select
  150. Range("A1").Select
  151.  
  152. End Sub
  153.  
  154.  
  155. Sub Marts()
  156. 'marts Makro
  157. 'Denne makro er designet til at markere samtlige ordre fortaget i marts måned.
  158.  
  159. Sheets("Data").Select
  160. Range("C2").Select
  161.  
  162.  
  163. Do Until ActiveCell.Value = ""
  164.  
  165. If Month(ActiveCell.Value) = 3 Then
  166. With ActiveCell
  167. .Interior.Color = vbBlue
  168. .Font.Bold = True
  169. .Font.Color = vbWhite
  170. End With
  171. End If
  172.  
  173. ActiveCell.Offset(1, 0).Select
  174. Loop
  175.  
  176. Range("A1").Select
  177.  
  178. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement