其他 PC 上的图表模板

Question

我做了一些图表作为模板，它们必须始终相同，但也可以在其他用户想要使用它（打开）时起作用。

如何修复此宏以便任何人都可以使用相同的模板而无需手动更改 path/location 图表？有没有办法让宏 "detects" 图表所在的文件夹？

直到现在，每当别人想使用模板时，我都必须更改路径。这是浪费时间，也是一个安全问题。

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

Answer 1

您可以有多种选择来解决问题

您可以改用此路径

%userprofile%/Desktop/Original

举个例子：对于部分

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

您可以将其替换为

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

替换所有类似的路径然后要求用户将模板文件夹粘贴到他们的桌面上。

第二个选项是如果你在网络上；将模板保存在共享文件夹并给出该共享文件夹的路径，因为它会在网络上保持不变，你不会有任何问题
可以使用相对路径，比如模板和文件在同一个文件夹，就可以使用./ .这个./指的是文件所在的目录。
你甚至可以使用
获取文件的当前目录
```
Application.ActiveWorkbook.Path 
```
或
```
Application.ActiveWorkbook.FullName
```
并使用路径创建模板的任何相对路径

您甚至可以通过询问用户从何处获取模板来使路径动态化，您可以使用如下代码

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

此函数将打开一个文件对话框，您必须 select 文件夹，它将 return 文件夹路径，然后可以在您的代码中使用该路径。

其他 PC 上的图表模板

Charts Template on other PC

excel

vba

excel-charts