饂飩コーディング

iOSアプリやら、Unityやら、Cocos2dやらごにょごにょ書いております

帳票フォームにボタン付けてもVisible設定できません。

はい、帳票フォームにボタンつけたら色々できそうですよね。
レコードの内容によってボタンの表示・非表示をコントロールしたいですよね。

はい!できません。

まぁ、レコードごとにボタンみたいなコントロールつけて管理してたら
システム不安定になるからでしょうかね・・・

代わりにテキストボックスを作って、データコントロール
iif文で文字列を制御するくらいならできます。
f:id:appdeappuappu:20210302214118p:plain

こんな感じで制御しておき、
f:id:appdeappuappu:20210302214301p:plain

こんな感じで明細行のフィールドを判断条件にすれば
ボタンチックな動きができるらしい。

Private Sub テキスト5_Click()
    If Me.右 = "xxx" Then
        MsgBox "xxx"
    Else
    End If
End Sub
|<

Excelファイルを開かずにパスワード有無を確認するには・・・

Excelでセルに=[Bファイル]Sheet1!$A$1
と書いてExcelファイルを開かずに他のファイルのセル値を取得することができますよね?
それをexcelVBAで下の様に書くと、パスワードがかかったファイルは#Ref!になって検出できます。

Sub ボタン1_Click()
    Dim A As String
    Dim cnt As Long
    
    On Error Resume Next
    
    A = Dir("c:\Work\*.xlsx")
    Application.DisplayAlerts = False
    Do While A <> ""
        cnt = cnt + 1
        Cells(cnt, 1) = A
        
        SendKeys "{ESC}"
        
        Cells(cnt, 2) = "='c:\Work\[" & A & "]Sheet1'!A1"
        A = Dir()
    Loop
    Application.DisplayAlerts = True
    
    With Range(Range("B1"), Range("B1").End(xlDown))
        .Value = .Value
    End With
End Sub

f:id:appdeappuappu:20210223205635p:plain









Access VBA バージョン

Option Compare Database
Option Explicit

Private Sub cmdCreateExcelFiles_Click()
     Dim DesktopPath As String, FilePath As String, WSH As Variant
    Set WSH = CreateObject("Wscript.Shell")
    DesktopPath = WSH.SpecialFolders("Desktop")
    'FilePath = DesktopPath & "\work" & "\CreatedByVBAFile.xlsx"

    Dim i As Long
    For i = 1 To 100
        FilePath = DesktopPath & "\work" & "\CreatedByVBAFile" & i & ".xlsx"
        Call CreateExcelFiles(FilePath)
    Next i
    Set WSH = Nothing
End Sub

Private Sub cmdCheckPass_Click()

    Dim ExApp As Object
    Set ExApp = CreateObject("Excel.Application")
    ExApp.Visible = True
    Dim DesktopPath As String, FilePath As String, WSH As Variant
    Set WSH = CreateObject("Wscript.Shell")
    DesktopPath = WSH.SpecialFolders("Desktop")
    FilePath = DesktopPath & "\createdExcel.xlsx"

    ExApp.Workbooks.Add

    Dim A As String
    Dim cnt As Long

    On Error Resume Next

    A = Dir("C:\Users\ユーザー名\Desktop\work\*.xlsx")
    ExApp.DisplayAlerts = False
    Do While A <> ""
        cnt = cnt + 1
        ExApp.Workbooks(ExApp.Workbooks.Count).Sheets(1).Cells(cnt, 1) = A

        ExApp.SendKeys "{ESC 3}"
        
        ExApp.Workbooks(ExApp.Workbooks.Count).Sheets(1).Cells(cnt, 2) = "='C:\Users\ユーザー名\Desktop\work\[" & A & "]Sheet1'!A1"
       
        If (IsError(ExApp.Workbooks(ExApp.Workbooks.Count).Sheets(1).Cells(cnt, 2))) Then
            ExApp.Workbooks(ExApp.Workbooks.Count).Sheets(1).Cells(cnt, 3) = "Locked"
        Else
            ExApp.Workbooks(ExApp.Workbooks.Count).Sheets(1).Cells(cnt, 3) = "---"
        End If
        
        A = Dir()
    Loop


'    With Range(Range("B1"), Range("B1").End(xlDown))
'        .Value = .Value
'    End With


    With ExApp.Workbooks(ExApp.Workbooks.Count)
        
        .SaveAs FileName:=FilePath
        .Close
    End With


    ExApp.Quit

    Set ExApp = Nothing
    Set WSH = Nothing

End Sub



Private Sub CreateExcelFiles(getFileName As String)
    Dim ExApp As Object
    Set ExApp = CreateObject("Excel.Application")
    ExApp.Visible = False
    Dim DesktopPath As String, FilePath As String, WSH As Variant
    Set WSH = CreateObject("Wscript.Shell")
    DesktopPath = WSH.SpecialFolders("Desktop")
    FilePath = getFileName

    ExApp.Workbooks.Add
    With ExApp.Workbooks(ExApp.Workbooks.Count)
        .Sheets(1).Cells(1, 1) = Now()
        .SaveAs FileName:=FilePath
        .Close
    End With
    ExApp.Quit

    Set ExApp = Nothing
    Set WSH = Nothing
End Sub

Access vba でexcelを操作してみる

参考にさせていただきました。
note.com

www.bayashita.com

Public Sub excelSample()
    Dim xlApp As Object 'Excelアプリ'
    Dim xlBook As Object 'Excelブック'
    Dim xlSheet As Object 'Excelシート'

        
    Set xlApp = CreateObject("Excel.Application")
        xlApp.Visible = True
    Set xlBook = xlApp.Workbooks.Open("C:\Users\xxxxxxx\Desktop\sampleExcel.xlsx")
    Set xlSheet = xlBook.Worksheets("Sheet1")

        
        ' ブックの全シートを 1 つずつループして処理する
        Dim objSheet As Worksheet
            For Each objSheet In xlBook.Worksheets
                Debug.Print objSheet.Name & "を処理します"
    
                'A1セルにシートの名前を書き込む
                objSheet.Cells(1, 1) = "このシートの名前は" & objSheet.Name & "です。"
                'シートを印刷する。
                objSheet.PrintOut
            Next
        

'    Set rs = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
End Sub
Private Sub dispExcelData(ByVal recievedFullPath As String)
    Dim xlApp As Object 'Excelアプリ'
    Dim xlBook As Object 'Excelブック'
    Dim xlSheet As Object 'Excelシート'

    Set xlApp = CreateObject("Excel.Application")
        xlApp.Visible = False
        xlApp.Application.DisplayAlerts = False
    Set xlBook = xlApp.Workbooks.Open(recievedFullPath)
    'Set xlSheet = xlBook.Worksheets("Sheet1")

        
        ' ブックの全シートを 1 つずつループして処理する
        Dim objSheet As Object
        Dim rng As Object
            For Each objSheet In xlBook.Worksheets
                objSheet.Activate
                Debug.Print objSheet.Name & "を処理します*****************"
                
                Set rng = objSheet.range("A1:B6")
                Dim vnt As Variant
                vnt = rng.Value
                
                Dim msg As String
                Dim x As Integer
                Dim i As Long
                msg = ""
                For x = 1 To UBound(vnt)
                    msg = msg & vnt(x, 1) & " " & vnt(x, 2) & vbCrLf
                Next
                MsgBox msg
                Dim testString As String
                testString = objSheet.range("B2").Value
                MsgBox testString
                testString = objSheet.range("B3").Value
                MsgBox testString
                testString = objSheet.range("B4").Value
                MsgBox testString
                testString = objSheet.range("B5").Value
                MsgBox testString
                
                objSheet.range("B2").Value = "cccc"
                objSheet.range("B2").interior.colorindex = 4
                objSheet.range("A6").ShrinkToFit = True
                Debug.Print objSheet.Name & "を処理終了*****************"
                 
            Next objSheet
        
 

    'xlApp.Quit
    
    xlBook.Save
    xlApp.Application.DisplayAlerts = True
    xlBook.Close
    xlApp.Quit
'    Set xlSheet = Nothing
'    Set xlBook = Nothing
'    Set xlApp = Nothing
    
   
End Sub

VBAでコマンドプロンプトたたいた結果を受け取ろう

参考にさせていただきました。
officetanaka.net

Sub xpdf_pdfinfo_getInformation()
    Dim WSH, wExec, sCmd As String, Result As String
    Set WSH = CreateObject("WScript.Shell")         ''(1)
    sCmd = "dir C:\"
    sCmd = "C:\Users\xxxx\Desktop\test\pdfinfo.exe C:\Users\xxxx\Desktop\test\no.pdf" ''(2)
    sCmd = "C:\Users\xxxx\Desktop\test\pdfinfo.exe C:\Users\xxxx\Desktop\test\password.pdf" ''(2)
    Set wExec = WSH.Exec("%ComSpec% /c " & sCmd)    ''(3)
    Do While wExec.Status = 0                       ''(4)
        DoEvents
    Loop
    Result = wExec.StdOut.ReadAll                   ''(5)
    MsgBox Result
    Set wExec = Nothing
    Set WSH = Nothing
End Sub

f:id:appdeappuappu:20210201221542p:plain

VBAでリストにプリンター一覧を追加し、選択したプリンタでPDFを印刷する。

以下の感じでリストにアイテムを追加する。

Private Sub Form_Load()
'フォーム読み込み時
  Dim prt As Printer
  'すべてのプリンタを列挙してコンボボックスの値集合ソースに追加
  For Each prt In Application.Printers
    Me.リスト10.AddItem prt.DeviceName
  Next prt
End Sub

ボタンが押されたら、PDFの印刷をするのですが、
ここでどのプリンタを選択するかは上記でセットしたリストの値に置き換えています。

Private Sub コマンド12_Click()
    '[印刷]ボタンクリック時

  'プリンタ変数を宣言
  Dim prtDefault As Printer
  '現在のプリンタ設定を退避
  Set prtDefault = Application.Printer 'これがデフォルトプリンタ
  '選択されたプリンタの情報を設定
  Set Application.Printer = Application.Printers(Me.リスト10.Value)
  
  '印刷するぞ
  
  'シェルオブジェクトの作成
    Dim shellObj As Object
    Set shellObj = CreateObject("WScript.shell")
    
    Dim exeStm As String
    
    'コマンドラインの文字列を作成する
        exeStm = "AcroRd32.exe /t" & " " & "C:\Users\XXXXX\Desktop\test.pdf" & " " & Application.Printer.DeviceName
        shellObj.Run (exeStm)   '印刷する
  
  'プリンタ設定を元に戻す
  Set Application.Printer = prtDefault

 Set prtDefault = Nothing
End Sub

excelファイルの印刷時にプリンタを指定するならば、以下の感じで!

myExcel.ActiveWorkbook.PrintOut ActivePrinter:=Me.リスト10