由不同的用户运行不同的macros或代码部分

我写了一个macros来保存一个文件到一个特定的URL。 问题在于，我的公司中的不同用户使用不同级别的权限来访问Intranet文件夹。 该macros由电子表格上的button激活。 据我所知，我至less有两个解决scheme：

1. 创build不同的macros，并将它们链接到不同的button（用户将按各自的button。不优雅的可能性出错）
2. 使VBA识别用户，并使用正确的SAVE AS url运行特定的macros或代码string。 我会避免第一个解决scheme，但我不知道如何写第二个解决scheme。

以下是SAVE AS方法中的完整代码：

Sub test_salva() Workbooks.Open Filename:= _ "\\Share\Qualita_MG\Gestione Documentazione\Doc. TECNICI- QUALITA'\Moduli di supporto\C - Controllo Qualita'\MOD UNICO.xlsm" Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate ActiveSheet.Range("A3").Select Do While Not IsEmpty(ActiveCell) ActiveCell.Offset(1, 0).Select Loop ActiveCell.Offset(-1, 0).Select Selection.Copy Windows("MOD UNICO.xlsm").Activate Sheets("Ita-Eng").Activate Range("AF31").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate ActiveCell.Offset(0, 1).Range("A1").Select Application.CutCopyMode = False Selection.Copy Windows("MOD UNICO.xlsm").Activate Sheets("Ita-Eng").Activate Range("R2").Select ActiveSheet.Paste Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate ActiveCell.Offset(0, 1).Range("A1").Select Application.CutCopyMode = False Selection.Copy Windows("MOD UNICO.xlsm").Activate Sheets("Ita-Eng").Activate Range("B5").Select ActiveSheet.Paste Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate ActiveCell.Offset(0, 1).Range("A1").Select Application.CutCopyMode = False Selection.Copy Windows("MOD UNICO.xlsm").Activate Sheets("Ita-Eng").Activate Range("AD4").Select ActiveSheet.Paste Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate ActiveCell.Offset(0, 1).Range("A1").Select Application.CutCopyMode = False Selection.Copy Windows("MOD UNICO.xlsm").Activate Sheets("Ita-Eng").Activate Range("AD5").Select ActiveSheet.Paste Application.CutCopyMode = False progressivo = Range("AF31") nomefile = Range("B5") ActiveWorkbook.SaveAs Filename:= _"\\Share\Qualita_MG\Documentazione registrazione\Certificati SERIE\2015\S - Certificati Tubi\" & progressivo & "-" & nomefile _ , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate ActiveSheet.Range("A3").Select Do While Not IsEmpty(ActiveCell) ActiveCell.Offset(1, 0).Select Loop ActiveCell.Offset(-1, 0).Select variabile = Selection nome = ActiveCell.Range("c1") ActiveCell.Offset(0, 2).Range("A1").Select ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _ "S%20-%20Certificati%20Tubi\" & variabile & "-" & nome & ".xlsm", TextToDisplay:=nome ActiveCell.Offset(1, -2).Range("A1").Select End Sub 

Answer 1

我想解决我的问题：

 Sub test_salva() **If Application.UserName = "Manuela Frignani" Then GoTo line1 Else GoTo line2** **line1:** Workbooks.Open Filename:= _ "Z:\Certificati SERIE\2015\MOD UNICO.xlsm" Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate ActiveSheet.Range("A3").Select Do While Not IsEmpty(ActiveCell) ActiveCell.Offset(1, 0).Select Loop ActiveCell.Offset(-1, 0).Select Selection.Copy Windows("MOD UNICO.xlsm").Activate Sheets("Ita-Eng").Activate Range("AF31").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate ActiveCell.Offset(0, 1).Range("A1").Select Application.CutCopyMode = False Selection.Copy Windows("MOD UNICO.xlsm").Activate Sheets("Ita-Eng").Activate Range("R2").Select ActiveSheet.Paste Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate ActiveCell.Offset(0, 1).Range("A1").Select Application.CutCopyMode = False Selection.Copy Windows("MOD UNICO.xlsm").Activate Sheets("Ita-Eng").Activate Range("B5").Select ActiveSheet.Paste Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate ActiveCell.Offset(0, 1).Range("A1").Select Application.CutCopyMode = False Selection.Copy Windows("MOD UNICO.xlsm").Activate Sheets("Ita-Eng").Activate Range("AD4").Select ActiveSheet.Paste Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate ActiveCell.Offset(0, 1).Range("A1").Select Application.CutCopyMode = False Selection.Copy Windows("MOD UNICO.xlsm").Activate Sheets("Ita-Eng").Activate Range("AD5").Select ActiveSheet.Paste Application.CutCopyMode = False progressivo = Range("AF31") nomefile = Range("B5") ActiveWorkbook.SaveAs Filename:= _ "Z:\Certificati SERIE\2015\S - Certificati Tubi\" & progressivo & "-" & nomefile _ , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate ActiveSheet.Range("A3").Select Do While Not IsEmpty(ActiveCell) ActiveCell.Offset(1, 0).Select Loop ActiveCell.Offset(-1, 0).Select variabile = Selection nome = ActiveCell.Range("c1") ActiveCell.Offset(0, 2).Range("A1").Select ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _ "S%20-%20Certificati%20Tubi\" & variabile & "-" & nome & ".xlsm", TextToDisplay:=nome With Selection.Font .Name = "Calibri Light" .Size = 17.6 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleSingle .ThemeColor = xlThemeColorHyperlink .TintAndShade = 0 .ThemeFont = xlThemeFontNone End With Selection.Font.Size = 16 Selection.Font.Size = 14 Selection.Font.Size = 12 Selection.Font.Size = 11 Selection.Font.Size = 10 Selection.Font.Underline = xlUnderlineStyleNone Selection.Font.Underline = xlUnderlineStyleSingle With Selection.Font .ThemeColor = xlThemeColorLight1 .TintAndShade = 0.499984740745262 End With ActiveCell.Offset(1, -2).Range("A1").Select GoTo line3 **line2:** Workbooks.Open Filename:= _ "\\Share\Qualita_MG\Gestione Documentazione\Doc. TECNICI- QUALITA'\Moduli di supporto\C - Controllo Qualita'\MOD UNICO.xlsm" Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate ActiveSheet.Range("A3").Select Do While Not IsEmpty(ActiveCell) ActiveCell.Offset(1, 0).Select Loop ActiveCell.Offset(-1, 0).Select Selection.Copy Windows("MOD UNICO.xlsm").Activate Sheets("Ita-Eng").Activate Range("AF31").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate ActiveCell.Offset(0, 1).Range("A1").Select Application.CutCopyMode = False Selection.Copy Windows("MOD UNICO.xlsm").Activate Sheets("Ita-Eng").Activate Range("R2").Select ActiveSheet.Paste Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate ActiveCell.Offset(0, 1).Range("A1").Select Application.CutCopyMode = False Selection.Copy Windows("MOD UNICO.xlsm").Activate Sheets("Ita-Eng").Activate Range("B5").Select ActiveSheet.Paste Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate ActiveCell.Offset(0, 1).Range("A1").Select Application.CutCopyMode = False Selection.Copy Windows("MOD UNICO.xlsm").Activate Sheets("Ita-Eng").Activate Range("AD4").Select ActiveSheet.Paste Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate ActiveCell.Offset(0, 1).Range("A1").Select Application.CutCopyMode = False Selection.Copy Windows("MOD UNICO.xlsm").Activate Sheets("Ita-Eng").Activate Range("AD5").Select ActiveSheet.Paste Application.CutCopyMode = False progressivo = Range("AF31") nomefile = Range("B5") ActiveWorkbook.SaveAs Filename:= _ "\\Share\Qualita_MG\Documentazione registrazione\Certificati SERIE\2015\S - Certificati Tubi\" & progressivo & "-" & nomefile _ , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False Windows("RIEPILOGATIVO 2015.xlsb.xlsm").Activate ActiveSheet.Range("A3").Select Do While Not IsEmpty(ActiveCell) ActiveCell.Offset(1, 0).Select Loop ActiveCell.Offset(-1, 0).Select variabile = Selection nome = ActiveCell.Range("c1") ActiveCell.Offset(0, 2).Range("A1").Select ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _ "S%20-%20Certificati%20Tubi\" & variabile & "-" & nome & ".xlsm", TextToDisplay:=nome With Selection.Font .Name = "Calibri Light" .Size = 17.6 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleSingle .ThemeColor = xlThemeColorHyperlink .TintAndShade = 0 .ThemeFont = xlThemeFontNone End With Selection.Font.Size = 16 Selection.Font.Size = 14 Selection.Font.Size = 12 Selection.Font.Size = 11 Selection.Font.Size = 10 Selection.Font.Underline = xlUnderlineStyleNone Selection.Font.Underline = xlUnderlineStyleSingle With Selection.Font .ThemeColor = xlThemeColorLight1 .TintAndShade = 0.499984740745262 End With ActiveCell.Offset(1, -2).Range("A1").Select **line3:** End Sub