Er der en grund til du vil gøre det sådan? Men ja, du kan godt åbne en anden workbook (end den du har åben) og køre en makro fra den via din åbne workbook.
Jeg vil gerne kunne opdatere en model, som jeg har distribueret til resten af firmaet. Jeg vil gerne have at den enkelte medarbejder kan opdatere den model de sidder med ved blot at afvikle en makro fra en anden projektmappe.
Eksempelvis vil jeg gerne rette nogle funktioner i navngivne ark:
Jeg er ikke sikker på jeg forstår :-) I har 1 workbook som er delt på et shared drive? I den workbook, skal man kunne køre en makro som den læser fra en anden workbook?
Alle medarbejdere har flere StandardWorkbook (den fil jeg gerne vil kunne foretage opdateringer til) liggende i vores ESDH under de forskellige kunder.
Jeg vil med UpdateWorkbook gerne kunne foretage ændringer/opdateringer i StandardWorkbook.
Altså du kan sagtens opdatere andre workbooks fra en makro, men hvorfor åbner du ikke bare StandardWorkbook og laver opdateringen? Hvad vinder du/I på at du skal kode alle dine opdateringer/ændringer? Måske er det fordi jeg ikke kan se det smarte i det :-) Er det blot formler du vil ændre? En løsning kunne være at lave en makro i din UpdateWorkbook, som åbner en dialog box hvor du kan vælge den Excel workbook som du vil opdatere (StandardWorkbook). I din UpdateWorkbook har du den nye formel i en specifik celle, f.eks. A2. Efter du har åbnet StandardWorkbook, så kan en input box komme frem, hvor du angiver rangen (f.eks. B2:D2) hvor den nye formel skal ind. Er det sådan noget du er ude efter?
Det er noget i den stil. Der er rigtig mange rettelser til formler, datavalidering, formatering og ligeledes ændringer i nogle makroer og userforms.
Hvordan vil du lave en MSGboks der kan søge efter åbne Workbooks og vise en liste over disse, give mulighed for at vælge en Workbook, der efter valg kan anvendes foran mine ændringslinjer?
Jeg har lavet dette til dig, jeg håber det gør som du ønsker eller kan hjælpe dig på vej. Indsæt nedenstående kode i et nyt module i VBA og kør "Open_Workbook_Insert_Formula" proceduren. Det der sker, er at den beder dig om at åbne den Excel workbook som du vil have opdateret formlerne i. Derefter skal du vælge den range hvor du vil indsætte formlen - formlen bliver indsat fra den workbook, hvor du kører makroen fra, i det aktive ark i cell A2. Den vil automatisk lave en "autofill", så celle referencer bliver opdateret ligesom hvis du bruger autofill i Excel. Du kan også selv "afkommentere" Debug.Print og se hvad der sker i dit Immediate window når du laver en step through/into (F8).
Option Explicit Public strFname As String, strShtUpdate As String Public wkbUpdate As Workbook
Sub Open_Workbook_Insert_Formula() Dim SaveDriveDir As String Dim strMyPath As String Dim varFnameWPath As Variant Dim N As Long Dim wkb As Workbook
Set wkbUpdate = ThisWorkbook strShtUpdate = wkbUpdate.ActiveSheet.Name
' Save the current directory. SaveDriveDir = CurDir
' Set the path to the folder that you want to open strMyPath = Application.DefaultFilePath
' Change drive/directory to strMyPath ChDrive strMyPath ChDir strMyPath
' Open GetOpenFilename with the file filters. varFnameWPath = Application.GetOpenFilename( _ FileFilter:="Excel Workbooks (*.xls*),*.xls*", _ Title:="Select an Excel workbook", _ MultiSelect:=False)
If varFnameWPath = False Then Exit Sub ' If Cancel then exit procedure
With Application ' Speed up sheet .ScreenUpdating = False .EnableEvents = False End With
' Get only the file name and test to see if it is open. strFname = Right(varFnameWPath, Len(varFnameWPath) - InStrRev(varFnameWPath, Application.PathSeparator, , 1)) If bIsBookOpen(strFname) = False Then
Set wkb = Nothing On Error Resume Next Set wkb = Workbooks.Open(varFnameWPath) On Error GoTo 0
If Not wkb Is Nothing Then ' Do nothing when opened, just continue End If Else ' If already open then MsgBox "You cannot open this file : " & varFnameWPath & " because it is already open." & vbNewLine & _ "Please close the workbook and try again" GoTo EndOfFile End If
' After workbook is open, start Call SelectUserRange(strFname, wkbUpdate, strShtUpdate)
EndOfFile: With Application ' Reset settings .ScreenUpdating = True .EnableEvents = True End With
' Change drive/directory back to SaveDriveDir. ChDrive SaveDriveDir ChDir SaveDriveDir End Sub
Function bIsBookOpen(ByRef szBookName As String) As Boolean On Error Resume Next bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing) End Function
Sub SelectUserRange(strFname, wkbUpdate, shtUpdate) Dim UserRange As Range Dim strRangeSheet As String, strRangeWkb As String
ReTry: On Error GoTo ReTry 'Debug.Print strFname Workbooks(strFname).Activate Worksheets(1).Activate
Application.ScreenUpdating = True ' Must be enabled for the InputBox to work
Set UserRange = Application.InputBox(prompt:="Please Select Range", Title:="Range Select", Type:=8)
Workbooks(strRangeWkb).Worksheets(strRangeSheet).Range(UserRange.Address).Formula = Workbooks(wkbUpdate.Name).Worksheets(strShtUpdate).Range("A2").Formula End Sub
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
Ny bruger
Nybegynder
Opret
Preview
