Nsryjdtyk

Greets! So, I made some charts as templates, and they have to be always the same, but also be able to function when some other users wanna use it (to open). My question is, how to fix this macro that I made so that anyone else can use the same templates but without Manually changing path/location of charts, is it a way to that MAcro "detects" the folder where the charts are??

Until now I have to change PAth everytime if someone else wanna use templates, but I dont wanna that, its a quite waste of time and also Security issue.

Hopefully you got my question!

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:UsersMirzaVDesktopOriginal"

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:UsersMirzaVDesktopTemplatesEinlaß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:UsersMirzaVDesktopTemplatesEinlaß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:UsersMirzaVDesktopTemplatesModulTemperatur.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:UsersMirzaVDesktopTemplatesModulTemperatur.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:UsersMirzaVDesktopTemplatesAuslasskonzentration.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

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:UsersMirzaVDesktopTemplatesEinlaßheizung.crtx" _
   
   )
   
   

   
   
   

   You can replace it with

   
   
   

   ActiveChart.ApplyChartTemplate ( _
   
   "%userprofile%DesktopTemplatesEinlaß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.