Search code examples
excelvbaexcel-charts

Charts Template on other PC

I made some charts as templates, and they have to always be the same, but also be able to function when some other users want to use it (to open).

How to fix this macro so anyone can use the same templates but without manually changing path/location of charts? Is there a way that the macro "detects" the folder where the charts are?

Until now I have to change path every time someone else wants to use templates. Its a waste of time and also a security issue.

Sub Schaltfläche3_Klicken()

Dim fd As FileDialog
Dim FileChosen As Integer
Dim FileName As String
Dim tempWB As Workbook
Dim i As Integer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set fd = Application.FileDialog(msoFileDialogFilePicker)

' *** Define the location ***
fd.InitialFileName = "C:\Users\MirzaV\Desktop\Original"
fd.InitialView = msoFileDialogViewList
fd.AllowMultiSelect = True

FileChosen = fd.Show
If FileChosen = -1 Then
For i = 1 To fd.SelectedItems.Count
    Set tempWB = Workbooks.Open(fd.SelectedItems(i))
    Call ReadDataFromSourceFile(tempWB)
Next i
End If

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Private Sub ReadDataFromSourceFile(src As Workbook)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


' *** Creating Charts ***

Range("A:A,J:K").Select
ActiveSheet.Shapes.AddChart2(240, xlXYScatterLinesNoMarkers).Select
ActiveChart.SetSourceData Source:=Range("Tabelle1!$A:$A,Tabelle1!$J:$K")
ActiveChart.ApplyChartTemplate ( _
    "C:\Users\MirzaV\Desktop\Templates\Einlaßheizung.crtx" _
    )
ActiveSheet.ChartObjects("Diagramm 1").Activate
ActiveChart.Axes(xlCategory).Select
ActiveChart.Axes(xlCategory).MinimumScaleIsAuto = True
ActiveChart.Axes(xlCategory).MaximumScaleIsAuto = True
ActiveChart.Axes(xlCategory).MajorUnit = 1
ActiveSheet.Shapes("Diagramm 1").Height = 240.9448818898
ActiveSheet.Shapes("Diagramm 1").Width = 453.5433070866
ActiveChart.ChartTitle.Select
Selection.Caption = "CS - Einlassheizung ()"
ActiveChart.Axes(xlValue).AxisTitle.Select
Selection.Caption = "Temperatur (°C)"
Columns("A:C").Select
ActiveSheet.Shapes.AddChart2(240, xlXYScatterLinesNoMarkers).Select
ActiveChart.SetSourceData Source:=Range("Tabelle1!$A:$C")
ActiveChart.ApplyChartTemplate ( _
    "C:\Users\MirzaV\Desktop\Templates\Einlaßdruck.crtx" _
    )
ActiveSheet.ChartObjects("Diagramm 2").Activate
ActiveChart.Axes(xlCategory).Select
ActiveChart.Axes(xlCategory).MinimumScaleIsAuto = True
ActiveChart.Axes(xlCategory).MaximumScaleIsAuto = True
ActiveChart.Axes(xlCategory).MajorUnit = 1
ActiveSheet.Shapes("Diagramm 2").Height = 240.9448818898
ActiveSheet.Shapes("Diagramm 2").Width = 453.5433070866
ActiveChart.ChartTitle.Select
Selection.Caption = "CS - Einlassdruck ()"
ActiveChart.Axes(xlValue).AxisTitle.Select
Selection.Caption = "Druck (mbar)"
Range("A:A,D:F").Select
ActiveSheet.Shapes.AddChart2(240, xlXYScatterLinesNoMarkers).Select
ActiveChart.SetSourceData Source:=Range("Tabelle1!$A:$A,Tabelle1!$D:$F")
ActiveChart.ApplyChartTemplate ( _
    "C:\Users\MirzaV\Desktop\Templates\ModulTemperatur.crtx")
ActiveSheet.ChartObjects("Diagramm 3").Activate
ActiveChart.Axes(xlCategory).Select
ActiveChart.Axes(xlCategory).MinimumScaleIsAuto = True
ActiveChart.Axes(xlCategory).MaximumScaleIsAuto = True
ActiveChart.Axes(xlCategory).MajorUnit = 1
ActiveSheet.Shapes("Diagramm 3").Height = 240.9448818898
ActiveSheet.Shapes("Diagramm 3").Width = 453.5433070866
ActiveChart.ChartTitle.Select
Selection.Caption = "CS - C1 - CC ()"
ActiveChart.Axes(xlValue).AxisTitle.Select
Selection.Caption = "Temperatur (°C)"
Range("A:A,G:I").Select
ActiveSheet.Shapes.AddChart2(240, xlXYScatterLinesNoMarkers).Select
ActiveChart.SetSourceData Source:=Range("Tabelle1!$A:$A,Tabelle1!$G:$I")
ActiveChart.ApplyChartTemplate ( _
    "C:\Users\MirzaV\Desktop\Templates\ModulTemperatur.crtx")
ActiveSheet.ChartObjects("Diagramm 4").Activate
ActiveChart.Axes(xlCategory).Select
ActiveChart.Axes(xlCategory).MinimumScaleIsAuto = True
ActiveChart.Axes(xlCategory).MaximumScaleIsAuto = True
ActiveChart.Axes(xlCategory).MajorUnit = 1
ActiveSheet.Shapes("Diagramm 4").Height = 240.9448818898
ActiveSheet.Shapes("Diagramm 4").Width = 453.5433070866
ActiveChart.ChartTitle.Select
Selection.Caption = "CS - C2 - CC ()"
ActiveChart.Axes(xlValue).AxisTitle.Select
Selection.Caption = "Temperatur (°C)"
Sheets("Tabelle2").Select
Columns("A:E").Select
ActiveSheet.Shapes.AddChart2(240, xlXYScatterLinesNoMarkers).Select
ActiveChart.SetSourceData Source:=Range("Tabelle2!$A:$E")
ActiveChart.ApplyChartTemplate ( _
    "C:\Users\MirzaV\Desktop\Templates\Auslasskonzentration.crtx")
ActiveSheet.ChartObjects("Diagramm 1").Activate
ActiveChart.Axes(xlCategory).Select
ActiveChart.Axes(xlCategory).MinimumScaleIsAuto = True
ActiveChart.Axes(xlCategory).MaximumScaleIsAuto = True
ActiveChart.Axes(xlCategory).MajorUnit = 1
ActiveSheet.Shapes("Diagramm 1").Height = 240.9448818898
ActiveSheet.Shapes("Diagramm 1").Width = 453.5433070866
ActiveChart.ChartTitle.Select
Selection.Caption = "CS - Auslasskonzentration ()"
ActiveChart.Axes(xlValue).AxisTitle.Select
Selection.Caption = "Auslasskonz. (ppb)"
Sheets("Tabelle1").Select
Application.CommandBars("Format Object").Visible = False
ActiveSheet.ChartObjects("Diagramm 4").Activate
ActiveSheet.Shapes("Diagramm 4").IncrementLeft 480
ActiveSheet.Shapes("Diagramm 4").IncrementTop 223
Range("U15").Select
ActiveSheet.ChartObjects("Diagramm 3").Activate
ActiveSheet.Shapes("Diagramm 3").IncrementLeft 480
ActiveSheet.Shapes("Diagramm 3").IncrementTop -22
Range("O8").Select
ActiveWindow.SmallScroll Down:=6
ActiveSheet.ChartObjects("Diagramm 2").Activate
ActiveSheet.Shapes("Diagramm 2").IncrementLeft 27
ActiveSheet.Shapes("Diagramm 2").IncrementTop 223
Range("L11").Select
ActiveSheet.ChartObjects("Diagramm 1").Activate
ActiveSheet.Shapes("Diagramm 1").IncrementLeft 27
ActiveSheet.Shapes("Diagramm 1").IncrementTop -22
Range("L9").Select
Sheets("Tabelle2").Select
ActiveSheet.ChartObjects("Diagramm 1").Activate
ActiveChart.Parent.Cut
Sheets("Tabelle1").Select
Range("C27").Select
ActiveSheet.Paste
ActiveSheet.ChartObjects("Diagramm 5").Activate


' *** Auswertungs Tabelle (Temperatur, Druck, min und max ***

Range("M1").Select
ActiveCell.FormulaR1C1 = "T01min"
Range("N1").Select
ActiveCell.FormulaR1C1 = "T01max"
Range("O1").Select
ActiveCell.FormulaR1C1 = "dT01"
Range("P1").Select
ActiveCell.FormulaR1C1 = "T01mw"
Range("Q1").Select
ActiveCell.FormulaR1C1 = "T02min"
Range("R1").Select
ActiveCell.FormulaR1C1 = "T02max"
Range("S1").Select
ActiveCell.FormulaR1C1 = "dT02"
Range("T1").Select
ActiveCell.FormulaR1C1 = "T02mw"
Range("U1").Select
ActiveCell.FormulaR1C1 = "P0min"
Range("V1").Select
ActiveCell.FormulaR1C1 = "P0max"
Range("W1").Select
ActiveCell.FormulaR1C1 = "p0mw"
Range("X1").Select
ActiveCell.FormulaR1C1 = "p1min"
Range("Y1").Select
ActiveCell.FormulaR1C1 = "p2max"
Range("Z1").Select
ActiveCell.FormulaR1C1 = "p2mw"
Range("Z2").Select
ActiveWindow.Zoom = 85
Range("M2").Select
ActiveCell.FormulaR1C1 = "=MIN(C[-3])"
Range("N2").Select
ActiveCell.FormulaR1C1 = "=MAX(C[-4])"
Range("O2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
Range("P2").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(C[-6])"
Range("Q2").Select
ActiveCell.FormulaR1C1 = "=MIN(C[-6])"
Range("R2").Select
ActiveCell.FormulaR1C1 = "=MAX(C[-7])"
Range("S2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
Range("T2").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(C[-9])"
Range("U2").Select
ActiveCell.FormulaR1C1 = "=MIN(C[-19])"
Range("V2").Select
ActiveCell.FormulaR1C1 = "=MAX(C[-20])"
Range("W2").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(C[-21])"
Range("X2").Select
ActiveCell.FormulaR1C1 = "=MIN(C[-21])"
Range("Y2").Select
ActiveCell.FormulaR1C1 = "=MAX(C[-22])"
Range("Z2").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(C[-23])"
Range("M2:Z2").Select
Selection.NumberFormat = "0.0"
Range("M1:Z2").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
Range("M1:Z1").Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent6
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
Selection.Font.Bold = True

    ' *** Close and SaveAs ***
        Application.ActiveWorkbook.Close

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub
Solution

  • You can have several option to solve the issue

    1. You can use this path instead

      %userprofile%/Desktop/Original

      As an example: For the part

      ActiveChart.ApplyChartTemplate ( _
"C:\Users\MirzaV\Desktop\Templates\Einlaßheizung.crtx" _
)

      You can replace it with

      ActiveChart.ApplyChartTemplate ( _
"%userprofile%\Desktop\Templates\Einlaßheizung.crtx" _
)

      Replace all paths like that ans after that ask the users to paste the template folder on their desktops.

    2. 2nd option is that if you are on a network; save the templates on a shared folder and give the path to that shared folder, as it will remain same on the network, you will not have any problem

    3. You can use relative path, for example, if the template is in the same folder as of the files, you can use ./ .This ./ refers to the directory of the file.

    4. You can even get the current directory of the file using

      Application.ActiveWorkbook.Path

      or

      Application.ActiveWorkbook.FullName

      and use the path to make any relative path to the template

    5. You can even make the path dynamic by asking the user from where to get the templates, you can use a code like below

      Sub SelectFolder()
Dim folder_path As String

With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = -1 Then
        folder_path = .SelectedItems(1)
    End If
End With

If folder_path <> "" Then

    MsgBox folder_path
Else
    MsgBox "No Folder was selected"
    End If
End Sub

      This function will open a file dialog, you have to select the folder and it will return the folder path, that path can then be used in your code.