ウェブページを表示するコントロールWebBrowserの表示を方法。表示のさせ方。

f:id:bimori466:20210403052656p:plain

ユーザフォーム上でGoogleを検索ができる

上の写真の様に、ユーザフォーム上にGoogleを表示できます。ユーザフォームの中で検索もできます。
いや、Chrome開けよ!って話なんですが。なんか面白いので記事にしてみました。

1 閲覧対象者

ユーザフォーム上で、Chromeを開いて検索したい方。

2 得られる効果

Chromoeを直に開かなくてよい。

3 WebBrowserをユーザフォームコントロールに表示する

以下の画面の蛍光線部が、WebBrowserコントロールです。しかし、デフォルトでは表示されません。
まずは表示方法から、解説します。

f:id:bimori466:20210403054052p:plain

1 ツールボックス_コントロールの確認

以下の画像の通り、WebBrowserコントロールはありません。では、追加していきましょう!

f:id:bimori466:20210403054410p:plain

2 WebBrowserコントロールの追加

以下の画像の通り、ツールボックス_コントロールを右クリックします。すると、その他のコントロールと出るので、クリックします。

f:id:bimori466:20210403054724p:plain


すると、以下のようなコントロールの追加画面が出てきます。ここで、「Microsoft Web Browser」にチェックを入れ追加します。

f:id:bimori466:20210403055100p:plain


こうすることで、ツールボックスの中に「WebBrowserコントロール」を選択できるようになります。

f:id:bimori466:20210403054052p:plain

4 WebBrowserコントロールを使ってみよう!

では、実際にWebBrowserコントロールを配置してみましょう!
WebBrowserコントロールを配置すると、以下の画像の様に真っ暗な画面になります。少々不安になりますが、これでOK!

f:id:bimori466:20210403055854p:plain


では、UserForm_Initialize処理時にWebBrowserコントロールに「Googleを表示」するように設定しましょう!

5 WebBrowserコントロールGoogleを表示する

コードは超絶簡単です。UserForm_Initializeの中に以下のコードを書き込みます。

Private Sub UserForm_Initialize()

    WebBrowser1.Navigate "https://www.google.co.jp/"

End Sub


こんだけです。では、標準モジュールにUserForm1.Showの処理を追加して実行すると以下の通り。

f:id:bimori466:20210403060454p:plain


何ということでしょう。ユーザーフォーム上にGoogleが表示されました。しかも、普通にこの中で検索できます。
以下の画像の通り、入力します(宣伝w)。

f:id:bimori466:20210403060826p:plain


Enterで検索すると、以下の画像の通り。何と言いうことでしょう、吾輩のブログがでてきました(宣伝w)。

f:id:bimori466:20210403061008p:plain


ちなみに、戻るボタンが表示されないのでその辺はショートカットキー「Alt+←」で検索画面に戻りましょう!

6 まとめ

いかがだったでしょうか。ユーザーフォーム上にWebブラウザを表示できるという感動はありつつも、Chrome開けばよくね?という正論の狭間にある心境です(;^ω^)。

しかし、IEコントロールで中の動きを制御できるみたいなので、Webスクレイピングの幅が広がったりするのか?。そんな期待感もあります。

この手の情報は、バスっとネットに転がってないんですよね。なんかいい記事みつけたら随時更新していきます。


ではでは、この辺で(^^)/~~~

全てのサブフォルダのファイル名を変更する。

全てのサブフォルダのファイル名を変更する

設計書のドキュメントファイルを自動生成する野良マクロと遭遇しました。怒りを覚えたが、お仕事なので解読しましたw。
その処理の中で、ドキュメント生成ができたら普通のファイル名、出来なければファイル名の頭に”×”が付きます。
10ファイルくらいならいいのですが、100ファイルを超えるとやってられないですよね。
なので、すべてのサブフォルダのエクセルファイル名を変更するコードを考えました。

1 自動生成されたファイルの例

以下の画像のようなファイル構成があります。
f:id:bimori466:20210320233921p:plain


以下の画像のように、ファイルA、ファイルBの中に先頭に×が付いているファイルと、付いていないファイルがあります。
f:id:bimori466:20210320232346p:plain


×が付いているファイルを、編集後に×を取ります。×がついたファイルが数百ファイルも有ったらやってられないですよね。
では、ピョログラミングでハムハムしましょう!

2 実際のコード

Sub サブフォルダのファイル名を更新する()

    Dim fso As Object: Set fso = CreateObject("scripting.filesystemobject")
    Dim myPath As String: myPath = ThisWorkbook.Path
    
    Dim targetPath As String
    Dim oldName As String
    Dim newName As String
    
    Dim myFolder As Variant
    For Each myFolder In fso.GetFolder(myPath).SubFolders
        
        targetPath = ThisWorkbook.Path & "\" & myFolder.Name
        
        Dim myFile As Variant
        For Each myFile In fso.GetFolder(targetPath).Files
            
            oldName = myFile.Name
            
            'ファイル名の頭に×があれば、MIDで×を除いたファイル名にする。
            If Mid(oldName, 1, 1) = "×" Then
                newName = Mid(oldName, 2)
                
                oldName = targetPath & "\" & oldName
                newName = targetPath & "\" & newName
                
                'ファイル名の変更(Nameステートメント)
                Name oldName As newName
            End If
        Next
    Next

End Sub


FSOと、Nameステートメントを使います!

3 処理結果

下の画面の通り、ファイル名から×が取れております。
f:id:bimori466:20210320233435p:plain


ファイル名を変更する「Name」ステートメント、VBA9年目にして初めて知りました。まだまだ奥が深いですVBA。


ではでは、この辺で(^^)/~~~

サブフォルダーのファイルを取得するVBA

f:id:bimori466:20210313010901p:plain

サブフォルダーのファイルまで取得するVBA

仕事が超絶楽になるはずだよ!

1 作成の経緯

ドキュメントの一括作成を迫られたのでw

2 コードを記載

以下のようにファイルA、B、C、Dのフォルダがあります。
f:id:bimori466:20210313004402p:plain


以下のようにフォルダの中にエクセルファイルが入っています。
f:id:bimori466:20210313004712p:plain

サブフォルダーを取得する実際のコード

Sub サブフォルダのファイルまで取得する()

    Dim fso As Object: Set fso = CreateObject("scripting.filesystemobject")
    
    Dim varTmp As Variant
    Dim myFolser As String
    
    
    Dim targetPath As String
    Dim targetSubPath As String
    
    Dim files As Variant
    Dim file As Variant
    Dim myFile As Variant
    
    targetPath = ThisWorkbook.Path
    
    For Each varTmp In fso.GetFolder(targetPath).SubFolders
    
        'Debug.Print varTmp.Name
            
        targetSubPath = targetPath & "\" & varTmp.Name
        
        Set files = fso.GetFolder(targetSubPath)
        Set file = files.files
        
        For Each myFile In file
            Debug.Print myFile.Name
        Next
    Next
    
    Set fso = Nothing

End Sub

処理結果

f:id:bimori466:20210313005822p:plain

3 感想

fsoを作って、サブフォルダを取得してイミディエイトウィンドウに出力しているだけです。
For Each myFile In fileの処理の中で、すべてのサブフォルダのファイルを処理できます!
いつでも、どこかで使えそう!


備忘録でした~。(^^)/~~~

ドキュメント自動生成ひな形

作成途中

Option Explicit

Sub すべてのファイルに値を代入()

'FSOを宣言
Dim fso_lord As Object: Set fso_lord = CreateObject("scripting.filesystemobject")
Dim wbPath As Variant
Dim myfiles As Variant
Dim file As Variant

Dim Input_wb As Workbook
Dim Input_LastLline As Long
Dim Output_Path As Variant


Dim mySh As Worksheet

Dim Item1 As String
Dim Filename As String


'pathの設定
wbPath = ThisWorkbook.Path & "\INPUTファイル\"

Set myfiles = fso_lord.getfolder(wbPath).Files
    
For Each file In myfiles
    If Not file.Name Like "~$*" Or file.Name Like ".xlsx" Then
        Call OpenBooks_String(wbPath & file.Name)
        Set Input_wb = ActiveWorkbook
        
        
        Workbooks.Add
        Filename = "成果物1"
        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\成果物\" & Filename
        Output_Path = ActiveWorkbook.Name
        
        
        'ブック間のデータのやり取り!
        Workbooks(file.Name).ActiveSheet.Range("A1").Copy Workbooks(Output_Path).Sheets(1).Range("A1")
        
        
'        Workbooks(file.Name).Activate
'        Sheets("INPUT_ITEM").Range("A1").Copy
'
'        Workbooks(Output_Path).Activate
'        Range("A1").PasteSpecial Paste:=xlPasteValues
'
        
        
        
        
        '対象のSheetを探す処理
        For Each mySh In Input_wb.Worksheets
            
            '特定のsheetを処理する
            If mySh.Name = "INPUT_ITEM" Then
                
                Item1 = mySh.Range("A2")
                
                MsgBox mySh.Name
            
            End If
            
        
        Next
        
    
        
        '転記する処理
        Workbooks.Add
        
        
        Call CloseBooks_Sring(file.Name)
    End If
Next


End Sub


Sub OpenBooks_String(ByVal mypath As String)
    
Workbooks.Open mypath
'Range("A1").Value = "自動で開きました。"

End Sub


Sub CloseBooks_Sring(ByVal myName As String)
    
Dim wb As Workbook
Set wb = Workbooks(myName)

wb.Close (True)

End Sub

ファイルの結合の項目チェックをするVBA!

ファイルの項目がInputファイル、outputファイルに存在するかを調べる

f:id:bimori466:20210228082517p:plain

INPUTファイルから、OUTPUTファイルを作りますよね。それなのに、OUTPUTファイルの項目に、INPUTファイルの項目が無いという現実(´;ω;`)。
こんな事態を打破すべく、ExcelVBAでチェックツールを作りました。

1 閲覧対象者

INPUTファイルとOUTPUTファイルの項目名が違うとお怒りの方w

2 得られる効果

OUTPUTファイルにINPUTファイルの項目が無いものを特定できる!

3 設計

1 以下の写真の通り、2つのINPUTファイルから1つのUnionファイル(OUTPUTファイル)を作成します。
f:id:bimori466:20210228080416p:plain


2 以下の写真の通り、マクロ「結合比較を実施します」
f:id:bimori466:20210228080634p:plain


3 以下の写真の通り、列F「判定」にINPUTファイルに含まれるものは「項目有」と表示される。空白のものが、INPUTファイルに項目が無いものとなる。
f:id:bimori466:20210228080758p:plain

4 コードの解説

<マクロ結合比較のコード>

Sub 結合比較()

    Dim ws As Worksheet: Set ws = Worksheets("結合比較")
    
    Dim input1 As Long: input1 = ws.Cells(Rows.Count, 1).End(xlUp).Row
    Dim input2 As Long: input2 = ws.Cells(Rows.Count, 3).End(xlUp).Row
    Dim Union_output As Long: Union_output = ws.Cells(Rows.Count, 5).End(xlUp).Row
    
    Dim serchItem As String
    Dim compItem As String
    Dim endFlg As Boolean
    
    
    'inputファイル1を探す
    Dim k_serchItem As Long
    For k_serchItem = 2 To Union_output
        endFlg = False
        serchItem = ws.Cells(k_serchItem, 5)
        
        Dim k_input1 As Long
        For k_input1 = 2 To input1
            compItem = ws.Cells(k_input1, 1)
            
            If serchItem = compItem Then
                ws.Cells(k_serchItem, 6) = "項目有"
                endFlg = True
                Exit For
            End If
            
        Next
        
        
        'inputファイル1に無い場合、Input2を探す
        If endFlg = False Then
            Dim k_input2 As Long
            For k_input2 = 2 To input2
                compItem = ws.Cells(k_input2, 3)
                
                If serchItem = compItem Then
                    ws.Cells(k_serchItem, 6) = "項目有"
                    endFlg = True
                    Exit For
                End If
            Next
        End If
    Next
    
End Sub


単純なコードです。
For~NEXTでファイル1を検索し、その次にファイル2を検索する。
項目があれば、列Fに”項目有”と表示して、endFlgをTrueにする。この処理を繰り返す。

5 感想

この設計の場合、2つのファイルから1つのOUTPUTファイルを作る場合に限定されてしまします(;^ω^)。
3つのファイルから、2つのファイルを作るなどには対応していません。
そこらへんは改良が必要ですが、取り急ぎ業務改善に必要なコードを作ってみました。
私も別のパータンが出てきたら、改良を加えるつもりです。


ではでは、この辺で(^^)/~~~

UserFromのコマンドボタンクリックイベントを、ENTER、ESCキーに登録する。

1 用意するUserFrom画面

f:id:bimori466:20210220225925p:plain

OKを押したら、Msgboxが出る。Cancelボタンを押したら閉じる機能です。

2 コマンドボタンクリックイベント処理コードを書く

Private Sub CommandButton_OK_Click()
    
    MsgBox "OKを押しました。"
    
End Sub

Private Sub CommandButton_Cancel_Click()
    
    Unload Me
    
End Sub

3 ENTER、ESCキーを押したときに処理されるように登録するコード

Private Sub UserForm_Initialize()
    
    'EnterKey割り当て
    Me.CommandButton_OK.Default = True
    
    'EscKey割り当て
    Me.CommandButton_Cancel.Cancel = True

End Sub


これで、Enter押したらMsgboxが出る。ESCキー押したらUserFromを閉じるができます。


ではでは、この辺で(^^)/~~~

SQL 基本構文

1 行の挿入(insert)

基本構文

insert into テーブル
values('項目1','項目2'…)

(例1)

insert into 家計簿
values('2020-02-12','運搬費','タクシー','0','2000')

(例2:現在の日付を得る{CURRENT_DATE})

insert into 家計簿
values(CURRENT_DATE,'運搬費','タクシー','0','2000')

2 行の更新(update)

基本構文

update テーブル名
Set 項目 = '更新値'
Where 項目 ='条件値' ★このWhereがないとヤバい(全部同じ値で更新される)

(例)

update 家計簿
set メモ = 'トラック'
where 費目 = '運搬費'

(例2:2つの条件式を組み合わせたWhere句)

update 家計簿
set メモ = 'リムジン'
where 費目 ='運搬費' and 出金額 > 2000

(例3:文字の一部を置換する。費 → 代)

update 家計簿
set 費目 = replace(費目,'費','代')

3 行の削除(delete)

基本構文

delete from テーブル名
where 項目 ='条件値'

(例)

delete from 家計簿
where メモ = 'タクシー'

4 行の選択(Select)

基本構文

Select 項目 from テーブル名

(例1:テーブルのデータをすべて抽出)

Select * from 家計簿

(例2:以上、以下)

select * from 家計簿
where 出金額 > 3000 

(例3:NULL値を取得) ★NULLは'=(イコール)'では判定できない。

select * from 家計簿
where 費目 is null


★Nullで無い場合(is not Null)
select * from 家計簿
where 費目 is not null

(例4:パターンマッチング{項目メモに、文字列に"入"が入っている行})

select * from 家計簿
where メモ like '%入%'

例)4-2:パターンマッチング(1の後に5文字はいいている行)

select * from 家計簿
where メモ like '1_____'
  
エスケープ句 「Escape '$'」あり。

例)4-3:BETWEEN A AND B(A以上B未満)

select * from 家計簿
where 出金額 between 1000 and 3000   ★(1000円以上、3000以下)

例)4-4:in(複数値との比較)

select * from 家計簿
where 費目 in('食費','給料')
  
★not in
select * from 家計簿
where 費目 not in('食費','給料')

例)4-5:2つの条件を組み合わせたWhere句(and)

select * from 家計簿
where 費目 ='運搬費' and 出金額 >= 2000

SELECT文だけに可能な修飾

DISTINCT :重複行を除外
ORDER BY :検索結果の順序を並び替える
LIMIT  :検索結果の件数を限定して取得する。★SQL非標準。SQL ServerではTOP
UNION  :検索結果にほかの検索結果を足し合わせる
EXCEPT  :検索結果からほかの検索結果を差し引く
INTERSECT:検索結果とほかの検索結果で重複する部分を取得する

1)DISTINCT :重複行を除外
2)ORDER BY :検索結果の順序を並び替える

select * from 家計簿
order by 日付 desc  ★並び順の省略はASC(昇順)になる。descは

  
★複数列の並べ替え★
select * from 家計簿
order by 日付 asc ,出金額 desc

  
★列名でも指定可能★
select * from 家計簿
order by 1 asc ,5 desc

3)先頭から数件だけ取得(Limit)

select * from 家計簿
order by 5 desc Limit 2

*この場合2件


★先頭から3番目に高い出金額を取得する(Limit 1 OFFSET 2)★
select * from 家計簿
order by 5 desc Limit 1 offset 2
  

4)UNION:検索結果にほかの検索結果を足し合わせる

5 テーブルの作成(create table)

create table 家計簿2(
 日付 date,
 費目ID integer
)


create table 家計簿3(
 日付 date,
 費目ID integer,
 メモ varchar(100) default '不明'
)



6 テーブルの削除(Drop table)

基本構文

Drop table テーブル名

(例)

Drop table 家計簿2

7 テーブルの結合(join)

基本構文

select 選択列リスト from テーブルA
JOIN テーブルB
on 両テーブルの結合条件

(例1:2つのテーブルを結合)

select 家計簿.費目,家計簿集計.費目,家計簿集計.平均 from 家計簿
join 家計簿集計
on 家計簿.費目 = 家計簿集計.費目

8 副問い合わせ

Selectをネストする。

1つのSQL文で第歳の出費に関する費目と金額を求める。

select 費目,出金額 from 家計簿
where 出金額 = (SELECT max(出金額) from 家計簿)