Board logo

標題: [發問] 請問如何用vba來將模組或代碼寫入另一個excel [打印本頁]
作者: starry1314    時間: 2016-8-15 15:00     標題: 請問如何用vba來將模組或代碼寫入另一個excel

因為檔案需要更新但有上千個檔案 變成要一一打開匯入模組...
http://blog.xuite.net/crdotlin/excel/7633898-%E7%94%A8VBA%E4%BE%86%E7%94%A2%E7%94%9FVBA
只找到一個但是檔案已失效
作者: Scott090    時間: 2016-8-16 07:10

回復 1# starry1314


    假如被處理的檔案內容格式是一致的，
為什麼不能用只有有程式模組的一個工作簿來處理其他上千個檔案，而必須把程式拷貝或移置到其他檔案 ?

這是疑問也是建議，因為不知你的原始用意
作者: starry1314    時間: 2016-8-16 08:37

回復 2# Scott090

因為當初設計時設想不全,無法滿足想要的資料,故須做修正.....但老闆連往年資料也要就必須一個一個去開來插入程式碼
且因為需要讓每個檔案做完修改後會即時更新修改後的資料至aceess裡面,
故每個檔案必須都要有上傳的程式在內才能在儲存的時候更新資料
作者: lpk187    時間: 2016-8-16 10:45

回復 3# starry1314

給你一個大概的模型，其他的請自行修改內容
以下代碼必須在工具>>設定引用項目中，引用 Microsoft Visual Basic For Application Extensibility 5.3<<這個要勾選
  1. Option Explicit
  2. Public Sub ex()
  3.     Dim s As String
  4.     Dim VBCom As Object
  5.     Dim VBP
  6.     On Error Resume Next
  7.      Do
  8.         Err = 0
  9.         Set VBP = ActiveWorkbook.VBProject
  10.         If Err <> 0 Then
  11.             If MsgBox("巨集安全設置置不允許代代碼進行行操作。" & vbCrLf & vbCrLf & "請將信任中心內信任存取VBA專案物件模型勾選", vbCritical + vbYesNo, "巨集設定") = vbYes Then
  12.                 With Application
  13.                     .SendKeys "t"
  14.                     .CommandBars.FindControl(ID:=3627).Execute
  15.                 End With
  16.             Else
  17.                 Exit Sub
  18.             End If
  19.         End If
  20.     Loop Until Err = 0
  21.     On Error GoTo 0
  22.     s = "sub 合計()" & vbCrLf '
  23.     s = s & "    Dim rng1 As Range, rng2 As Range" & vbCrLf
  24.     s = s & "    Dim 日期 As Date" & vbCrLf
  25.     s = s & "    With Sheets(1)" & vbCrLf '
  26.     s = s & "        號碼 = .Cells(3, 18)" & vbCrLf
  27.     s = s & "        日期 = .Cells(2, 19)" & vbCrLf
  28.     s = s & "        Set rng1 = .Columns(1).Find(號碼)" & vbCrLf
  29.     s = s & "        Set rng2 = .Rows(1).Find(日期, LookIn:=xlValues)" & vbCrLf
  30.     s = s & "        .Cells(3, 19) = .Cells(rng1.Row, rng2.Column).Value" & vbCrLf
  31.     s = s & "    End With" & vbCrLf '
  32.     s = s & "End Sub"
  33.     Set VBCom = ThisWorkbook.VBProject.VBComponents.Add(1) '插入模組
  34.     VBCom.Name = "模組1" '變更模組名稱
  35.     With VBCom.CodeModule
  36.         .InsertLines .CountOfLines + 1, s '寫入代碼
  37.     End With
  38. End Sub
複製代碼
作者: lpk187    時間: 2016-8-16 10:47

回復 3# starry1314

Option Explicit
Public Sub ex()
    Dim s As String
    Dim VBCom As Object
    Dim VBP
    On Error Resume Next
     Do
        Err = 0
        Set VBP = ActiveWorkbook.VBProject
        If Err <> 0 Then
            If MsgBox("巨集安全設置置不允許代代碼進行行操作。" & vbCrLf & vbCrLf & "請將信任中心內信任存取VBA專案物件模型勾選", vbCritical + vbYesNo, "巨集設定") = vbYes Then
                With Application
                    .SendKeys "t"
                    .CommandBars.FindControl(ID:=3627).Execute
                End With
            Else
                Exit Sub
            End If
        End If
    Loop Until Err = 0
    On Error GoTo 0
    s = "sub 合計()" & vbCrLf '
    s = s & "    Dim rng1 As Range, rng2 As Range" & vbCrLf
    s = s & "    Dim 日期 As Date" & vbCrLf
    s = s & "    With Sheets(1)" & vbCrLf '
    s = s & "        號碼 = .Cells(3, 18)" & vbCrLf
    s = s & "        日期 = .Cells(2, 19)" & vbCrLf
    s = s & "        Set rng1 = .Columns(1).Find(號碼)" & vbCrLf
    s = s & "        Set rng2 = .Rows(1).Find(日期, LookIn:=xlValues)" & vbCrLf
    s = s & "        .Cells(3, 19) = .Cells(rng1.Row, rng2.Column).Value" & vbCrLf
    s = s & "    End With" & vbCrLf '
    s = s & "End Sub"
    Set VBCom = ThisWorkbook.VBProject.VBComponents.Add(1) '插入模組
    VBCom.Name = "模組1" '變更模組名稱
    With VBCom.CodeModule
        .InsertLines .CountOfLines + 1, s '寫入代碼
    End With
End Sub



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)