Шаблон диаграмм Excel VBA на другом ПК - PullRequest
Новая
       9

Шаблон диаграмм Excel VBA на другом ПК

0 голосов
/ 25 ноября 2018

здоровается!Итак, я сделал несколько диаграмм в качестве шаблонов, и они должны быть всегда одинаковыми, но также иметь возможность функционировать, когда некоторые другие пользователи захотят его использовать (чтобы открыть).У меня вопрос, как исправить этот макрос, который я сделал так, чтобы кто-нибудь еще мог использовать те же шаблоны, но без изменения пути / расположения диаграмм вручную, это способ, которым MAcro "обнаруживает" папку, в которой находятся диаграммы ??

До сих пор мне приходилось каждый раз менять PAth, если кто-то еще хочет использовать шаблоны, но я этого не хочу, это довольно бесполезная трата времени, а также проблема безопасности.

Надеюсь, вы получили мой вопрос!

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

1 Ответ

0 голосов
/ 26 ноября 2018

У вас может быть несколько вариантов решения проблемы

  1. Вы можете использовать этот путь вместо 

    %userprofile%/Desktop/Original

    Например: для детали 

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

    Вы можете заменить его на 

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

    Заменить все пути, аналогичные этим и после этого попросить пользователей вставить папку с шаблонами на свои рабочие столы.

  2. 2-й вариант - если вы находитесь в сети;сохраните шаблоны в общей папке и укажите путь к этой общей папке, так как в сети она останется неизменной, у вас не возникнет никаких проблем

  3. Вы можете использовать относительный путь дляНапример, если шаблон находится в той же папке, что и файлы, вы можете использовать ./. Этот ./ относится к каталогу файла.

  4. Вы можете даже получить текущийкаталог файла, используя 

    Application.ActiveWorkbook.Path

    или 

    Application.ActiveWorkbook.FullName

    и используйте путь для создания любого относительного пути к шаблону

  5. . Вы можетедаже сделать путь динамическим, спрашивая пользователя, где взять шаблоны, вы можете использовать код, подобный приведенному ниже 

    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

    Эта функция откроет диалоговое окно файла, вам нужно выбрать папку и она вернетсяпуть к папке, этот путь затем может быть использован в вашем коде.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...