Python勉強（８）：(続々)ここまでやってなんですが改めてさくらVPS初めからやり直し
さくらVPSにPython3インストール
⇒(続々)
ここまでやってなんですが改めてさくらVPS初めからやり直し
入門ガイド｜VPS（仮想専用サーバー）はさくらインターネット
１２）WordPress用データベース作成
なかなかphpMyAdminのインストールがうまくいかないので直接コマンドラインよりWordPress用のデータベース作成。
[root@*******]# mysql -u root -p
Enter password:
MariaDB [(none)]> create database wordpressdb collate utf8mb4_general_ci;
MariaDB [(none)]> exit
１３）WordPressインストール
なかなかphpMyAdminのインストールがうまくいかないので直接コマンドラインよりWordPress用のデータベース作成。
↓WordPressダウンロード
↓WordPressダウンロード
直接、WordPressのサイトからダウンロードするため
[root@*******]# cd /var/www/html
[root@*******]# wget https://ja.wordpress.org/wordpress-5.0-ja.tar.gz
でダウンロードし、
以下の手順に従いインストール
インストールしたのだが、うまく起動せずコードのまま表示される
なぜか調べたところ、PHPがうまくApacheに組み込まれていないこと判明
上記サイトの内容に従い、
再度、インストール
[root@*******]# yum install php
PhpMyadminの動作も含め確認完了
メルボルン（２）：メルボルン秋 2011/6/2
世界は、２２ヵ国くらいは回ったとは思うのですが、
まだ行ってない方が圧倒的多いです・・・
当たり前といえば当たり前ですが、北半球と南半球では季節が逆転します。
頭ではわかってはいても実際行ってみると素直にびっくりするものです。
（同じようにびっくりしたのが緯度が高いところの夏は日がなかなか沈まないのにもびっくりしたが）
下は、メルボルンに６月に行った時です。あっちは秋からに冬に向かうところでした。
撮影日：2011/6/2
撮影場所：メルボルン（オーストラリア）
撮影者：taikobox
-
メルボルン博物館側の公園
ば -
の公園
-
街中
-
行ってみないと、やってみないとわからないことだらけです。
この歳になっても・・・・＾＾：
Python勉強（7）：(続々)ここまでやってなんですが改めてさくらVPS初めからやり直し
さくらVPSにPython3インストール
⇒(続々)
ここまでやってなんですが改めてさくらVPS初めからやり直し
入門ガイド｜VPS（仮想専用サーバー）はさくらインターネット
１２）WordPress用データベース作成
なかなかphpMyAdminのインストールがうまくいかないので直接コマンドラインよりWordPress用のデータベース作成。
[root@*******]# mysql -u root -p
Enter password:
MariaDB [(none)]> create database wordpressdb collate utf8mb4_general_ci;
MariaDB [(none)]> exit
１３）WordPressインストール
なかなかphpMyAdminのインストールがうまくいかないので直接コマンドラインよりWordPress用のデータベース作成。
↓WordPressダウンロード
↓WordPressダウンロード
直接、WordPressのサイトからダウンロードするため
[root@*******]# cd /var/www/html
[root@*******]# wget https://ja.wordpress.org/wordpress-5.0-ja.tar.gz
でダウンロードし、
以下の手順に従いインストール
インストールしたのだが、うまく起動せずコードのまま表示される
なぜか調べたところ、PHPがうまくApacheに組み込まれていないこと判明
上記サイトの内容に従い、
再度、インストール
[root@*******]# yum install php
PhpMyadminの動作も含め確認完了
Python勉強（6）：(続)ここまでやってなんですが改めてさくらVPS初めからやり直し
さくらVPSにPython3インストール
⇒(続)
ここまでやってなんですが改めてさくらVPS初めからやり直し
入門ガイド｜VPS（仮想専用サーバー）はさくらインターネット
９）HTML／PHPの動作確認
PHPはスタートアップ時点でインストールされているので動作確認のみ。
アップデート用のSFTPソフト「WinSCP」使い、出力用ミニプログラムを準備⇒アップロードして動作確認。
(改め知ったことだがFTPって今はあまり使わないんですね・・・)
index.html⇒確認
test.html（php記述）⇒確認
１０）データベース設定
８）phpMyAdminもインストールした時点で、データベースにアクセスできないことに気が付いたので確認修正。
↓コマンドラインでデータベース起動；
[root@*******]# mysql -u root -p
Enter password:
ERROR 1045 (28000): Access denied for user 'root'@'localhost' (using password: NO)
＊mysql -u root -p＝「パスワードを使ってrootユーザーでMariaDBにログインする」
↓ERROR 1045 (28000): Access denied for user 'root'@'localhost'（権限設定無）表示
上記に従い、権限再設定しようとしたのですがうまく行かず...
調べると設定そのものしてないのではところで
↓mysql -u rootで起動パスワード再設定
[root@*******]# mysql -u root
MariaDB [(none)]> update mysql.user set password=password('パスワード') where user = 'root';
MariaDB [(none)]> flush privileges;
MariaDB [(none)]> exit;
うまくいきました
１１）SSL証明書用に Let’s Encryptをインストール
↓事前確認
[root@*******]# httpd -M
SSLモジュール確認
[root@*******]# firewall-cmd --list-all
ファイヤウォールのhttpsのアクティブ確認
↓ Let’s Encryptをインストール
[root@****** ~]# yum install certbot python2-certbot-apache
SSL＝Secure Sockets Layerの略。
インターネット上で情報を暗号化し安全な通信を提供するプロトコル。
Let's Encryptは、すべてのWebサーバへの接続を暗号化することを目指したプロジェクト。
2016年4月に正式に開始された認証局である。自動化された発行プロセスにより、TLSのX.509証明書の発行を無料で行っている。
↓ Let’s Encryptを設定
エラー出ました…。
Unable to find a virtual host listening on port 80 which is currently needed for Certbot to prove to the CA that you control your domain. Please add a virtual host for port 80.
ポート８０が見つからないとの事。方法探ると以下のサイト見つかったので
↓上記内容より、実行（Vimエディタで以下追記）
NameVirtualHost *:80
<VirtualHost *:80>
ServerAdmin root@freepc.jp
DocumentRoot /var/www/html
ServerName freepc.jp
</VirtualHost>
↓改めて certbot --apache -d ドメイン名 で申請
[root@****** ~]# certbot --apache -d kuccha-ne.com
今日、データーベースのブラウザアクセス可能にしてWordPressインストールそのうえでPythonのミニプログラム動かして完成！
⇒(続々)
VBA使用頻度の高いコード（２０）：ファイル名を読み出すマクロ
ファイル(フォルダ)名を読み出すマクロ
ファイル名をダイアログボックスを使って読み出すマクロ。単体で使うことは少ないですが他のマクロと組合わせて使うこと多いです。
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
’ファイル選択読み出してイメージに読込
Private Sub Exif_Path_Click()
Dim LoadFile As String
Dim GetFilePath As String
LoadFile = MsgBox("新規ファイル読込みます", vbYesNo)
If (LoadFile = vbNo) Then
Exit Sub
Else
ChDir ActiveWorkbook.Path
GetFilePath = Application.GetOpenFilename _
("jpg画像,*.jpg;*.jpeg", , "画像の選択", , False)
End If
ExifModify.Exif_Path = GetFilePath
ExifModify.Exif_Image.Picture = LoadPicture(GetFilePath)
Call GetExifinfo
End Sub
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Private Sub Folder_1_Click()
’フォルダ選択読み出してその中のJPGファイルをリストに取り持む
Dim LoadFile As String
Dim GetFilePath As String
Dim pkupFolder
LoadFile = MsgBox("新規フォルダ読込みます", vbOKCancel)
If (LoadFile = vbNo) Then
Exit Sub
Else
ckFolder.FileList.Clear
ChDir ActiveWorkbook.Path
'フォルダ名取込み
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
pkupFolder = .SelectedItems(1)
End If
End With
End If
ckFolder.Folder_1 = pkupFolder
If Dir(ckFolder.Folder_1, vbDirectory) = "" Then
MsgBox "フォルダがありません"
ckFolder.Folder_1 = ""
ElseIf Dir(ckFolder.Folder_1 & "\*.Jpg", vbDirectory) = "" Then
MsgBox "ファイルがありません"
ckFolder.Folder_1 = ""
Else
With ckFolder.FileList
pkupJpegFile = Dir(ckFolder.Folder_1 & "\*.Jpg")
Do While pkupJpegFile <> ""
ctFile = ctFile + 1
.AddItem pkupJpegFile
pkupJpegFile = Dir()
Loop
End With
ckFolder.ctFile_1 = ""
ckFolder.ctFile_2 = ""
ckFolder.ctFile_3 = ctFile
End If
End Sub
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
VBA使用頻度の高いコード（１９）：フォルダ数カウント ＆ フォルダ名出力
フォルダ数カウント ＆ フォルダ名出力
フォルダ数カウント ＆ フォルダ名出力マクロ。
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub フォルダー数カウント()
Dim TargetDir As String
Dim SubCount As Long
Dim i As Integer
Dim Photolist As Long
TargetDir = ThisWorkbook.Path ’ファイルのあるフォルダ
With CreateObject("Scripting.FileSystemObject")
SubCount = .GetFolder(TargetDir).SubFolders.Count
End With
'フォルダー数入力
Range("G1") = SubCount
End Sub
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub フォルダーリスト出力()
Dim TargetDir As String
Dim f As Object
Dim cnt As Long
Dim Obj As Object
Set Obj = CreateObject("Scripting.FileSystemObject")
' フォルダ名をシート上に出力する為のカウンタ
cnt = 0
TargetDir = ThisWorkbook.Path & "¥フォルダ名"
' 「C:\Sample」フォルダ配下に存在するフォルダを一つずつ参照する。
For Each f In Obj.GetFolder(TargetDir).SubFolders
' フォルダ名をシート上に出力する。
Range("A6").Offset(cnt, 0).Value = Obj.GetFolder(f).Name
cnt = cnt + 1
Next f
' オブジェクトを破棄する。
Set Obj = Nothing
Set f = Nothing
End Sub
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
VBA使用頻度の高いコード（１８）：空欄枠塗りつぶすマクロ
空欄枠塗りつぶすマクロ
空欄枠塗りつぶすマクロ。
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Dim blankCells As Range
Sub 枠作成()
'枠作成
Sheets("成果物").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Borders.LineStyle = xlContinuous
'空欄色塗り
For Each blankCells In Selection
If blankCells.Value = "" Then
blankCells.Interior.ColorIndex = 15
End If
Next
Range("A1").Select
End Sub
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
VBA使用頻度の高いコード（１７）：インターネットエクスプローラー上で開いているページのボタンをクリックする
インターネットエクスプローラー上で開いているページのボタンをクリックする
開いているインターネットエクスプローラーが指定されたページからページ上のボタンをクリックして別ページに移るプログラム。
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub 別ページ移動ボタンクリック()
Dim shl As Object 'シェルオブジェクト生成
Dim htmlDoc As HTMLDocument
Dim win As Object, getFlag, txtFlag, Tage As Boolean
Dim targetTitle As String 'タイトル確認
Dim objTag As Object '指定ボタン押す
Dim objLink As Object '指定リンクを押す
Set shl = CreateObject("Shell.Application")
targetTitle = "対象ページタイトル"
For Each win In shl.Windows '起動中のウィンドウを順番確認
'IEとエクスプローラがシェルで取得されるため、IEのみ処理
If TypeName(win.document) = "HTMLDocument" Then
If win.document.Title = targetTitle Then
Dim objIE As New InternetExplorer
Set objIE = win
getFlag = True '正しく取得できた
Exit For
End If
End If
Next
If getFlag = False Then
MsgBox "目的のWebページが開かれていません。⇒IE開きます", vbExclamation
Call IEOpen
Exit Sub
End If
'ページチェック
'HTMLタグがh2要素内の文言を判定し、対象のページか移動先でないこと判断する
For i = 0 To objIE.document.getElementsByTagName("h2").Length - 1
If (objIE.document.getElementsByTagName("h2")(i).innerText = "ページチェック用文字列") Then
txtFlag = True
Exit For
End If
Next i
'移動先のページでないこと確認
If (txtFlag = False ) Then
'送信(submit)をクリック
For Each objTag In objIE.document.getElementsByTagName("input")
If InStr(objTag.outerHTML, "対象ボタンの文字列") > 0 Then
'送信ボタンクリック
objTag.Click
'ループ脱出⇒タイミングよってはログアウトしているときがあるので一度確認必要
Tage = True
Exit Sub
End If
Next
ElseIf (txtFlag = True) Then
C54Tage = True
Else
'オブジェクト開放
Set shl = Nothing
Set win = Nothing
Set htmlDoc = Nothing
Unload OPreport_Check
End If
'オブジェクト開放
Set shl = Nothing
Set win = Nothing
Set htmlDoc = Nothing
End Sub
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
VBA使用頻度の高いコード（１６）：インターネットエクスプローラー上で開いているページを調べるコード
インターネットエクスプローラー上で開いているページを調べるコード
開いているインターネットエクスプローラーが指定されたページを開いているか確認するコード
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub ImportIE()
Dim shl As Object 'シェルオブジェクト生成
Dim htmlDoc As HTMLDocument
Dim win As Object, getFlag, txtFlag, PageFlag As Boolean
Dim targetTitle As String 'タイトル確認
Set shl = CreateObject("Shell.Application")
targetTitle = "特定するページのタイトル"
For Each win In shl.Windows '起動中のウィンドウを順番確認
'IEとエクスプローラがシェルで取得されるため、IEのみ処理
If TypeName(win.document) = "HTMLDocument" Then
If win.document.Title = targetTitle Then
Dim objIE As New InternetExplorer
Set objIE = win
getFlag = True '正しく取得できた
Exit For
End If
End If
Next
If getFlag = False Then
MsgBox "目的のWebページが開かれていません。⇒IE開きます", vbExclamation
Call IEOpen
Exit Sub
End If
Next i
Set shl = Nothing
Set win = Nothing
Set htmlDoc = Nothing
End Sub
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub IEOpen()
Dim IE As Object
target = "https://www.wave-s.jp/wave/"
Set IE = CreateObject("InternetExplorer.Application")
With IE
'(1)表示
'InternetExplorerを表示
.Visible = True
'指定したURLのページを表示する
.navigate target
'完全にページが表示されるまで待機する
Do While .Busy = True Or .readyState <> 4
DoEvents
Loop
'完全にドキュメントが読み込まれるまで待機する
Do While .document.readyState <> "complete"
DoEvents
Loop
End With
End Sub
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
VBA使用頻度の高いコード（１５）：地図情報管理用クラスモジュール
地図情報管理用クラスモジュール
地図情報管理用クラスモジュールを管理するために作成したクラスモジュールです
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
'番号に対する条件のクラス,見分けつけるため「_」を最終文字に添付
Private MapID_ As String '物件ID
Private シート名_ As String 'シート名
Private セルアドレス_ As String 'セルアドレス
Private 緯度_ As String '緯度
Private 経度_ As String '経度
Private 住所_ As String '住所
Private 地図URL緯度経度_ As String '地図URL緯度経
Private 地図URL住所_ As String '地図URL住所
Private 検索URL_ As String '検索URL
Private 予備項目1_ As String '予備項目1
Private 予備項目2_ As String '予備項目2
Private 写真ファイル名_ As String '写真ファイル名
Private 物件名_ As String '物件名
Private 補足_ As String '補足
Private 格納フォルダ_ As String '格納フォルダ
Private 検索追加ワード_ As String '検索追加ワード
'「MapID」というプロパティの設定プロシージャ
Property Let MapID(ByVal new_MapID As String)
MapID_ = new_MapID
End Property
'「MapID」というプロパティの取得プロシージャ
Property Get MapID() As String
MapID = MapID_
End Property
'「シート名」というプロパティの設定プロシージャ
Property Let シート名(ByVal new_シート名 As String)
シート名_ = シート名
End Property
'「シート名」というプロパティの取得プロシージャ
Property Get シート名() As String
シート名 = シート名_
End Property
'「セルアドレス」というプロパティの設定プロシージャ
Property Let セルアドレス(ByVal new_セルアドレス As String)
セルアドレス_ = new_セルアドレス
End Property
'「セルアドレス」というプロパティの取得プロシージャ
Property Get セルアドレス() As String
セルアドレス = セルアドレス_
End Property
'「緯度」というプロパティの設定プロシージャ
Property Let 緯度(ByVal new_緯度 As String)
緯度_ = new_緯度
End Property
'「緯度」というプロパティの取得プロシージャ
Property Get 緯度() As String
緯度 = 緯度_
End Property
'「経度」というプロパティの設定プロシージャ
Property Let 経度(ByVal new_経度 As String)
経度_ = new_経度
End Property
'「経度」というプロパティの取得プロシージャ
Property Get 経度() As String
経度 = 経度_
End Property
'「住所」というプロパティの設定プロシージャ
Property Let 住所(ByVal new_住所 As String)
住所_ = new_住所
End Property
'「住所」というプロパティの取得プロシージャ
Property Get 住所() As String
住所 = 住所_
End Property
'「地図URL緯度経度」というプロパティの設定プロシージャ
Property Let 地図URL緯度経度(ByVal new_地図URL緯度経度 As String)
地図URL緯度経度_ = new_地図URL緯度経度
End Property
'「地図URL緯度経度」というプロパティの取得プロシージャ
Property Get 地図URL緯度経度() As String
地図URL緯度経度 = 地図URL緯度経度_
End Property
'「地図URL住所」というプロパティの設定プロシージャ
Property Let 地図URL住所(ByVal new_地図URL住所 As String)
地図URL住所_ = new_地図URL住所
End Property
'「地図URL住所」というプロパティの取得プロシージャ
Property Get 地図URL住所() As String
地図URL住所 = 地図URL住所_
End Property
'「検索URL」というプロパティの設定プロシージャ
Property Let 検索URL(ByVal new_検索URL As String)
検索URL_ = new_検索URL
End Property
'「検索URL」というプロパティの取得プロシージャ
Property Get 検索URL() As String
検索URL = 検索URL_
End Property
'「予備項目1」というプロパティの設定プロシージャ
Property Let 予備項目1(ByVal new_予備項目1 As String)
予備項目1_ = new_予備項目1
End Property
'「予備項目1」というプロパティの取得プロシージャ
Property Get 予備項目1() As String
予備項目1 = 予備項目1_
End Property
'「予備項目2」というプロパティの設定プロシージャ
Property Let 予備項目2(ByVal new_予備項目2 As String)
予備項目2_ = new_予備項目2
End Property
'「予備項目2」というプロパティの取得プロシージャ
Property Get 予備項目2() As String
予備項目2 = 予備項目2_
End Property
'「写真ファイル名」というプロパティの設定プロシージャ
Property Let 写真ファイル名(ByVal new_写真ファイル名 As String)
写真ファイル名_ = new_写真ファイル名
End Property
'「写真ファイル名」というプロパティの取得プロシージャ
Property Get 写真ファイル名() As String
写真ファイル名 = 写真ファイル名_
End Property
'「物件名」というプロパティの設定プロシージャ
Property Let 物件名(ByVal new_物件名 As String)
物件名_ = new_物件名
End Property
'「物件名」というプロパティの取得プロシージャ
Property Get 物件名() As String
物件名 = 物件名_
End Property
'「補足」というプロパティの設定プロシージャ
Property Let 補足(ByVal new_補足 As String)
補足_ = new_補足
End Property
'「補足」というプロパティの取得プロシージャ
Property Get 補足() As String
補足 = 補足_
End Property
'「格納フォルダ」というプロパティの設定プロシージャ
Property Let 格納フォルダ(ByVal new_格納フォルダ As String)
格納フォルダ_ = new_格納フォルダ
End Property
'「格納フォルダ」というプロパティの取得プロシージャ
Property Get 格納フォルダ() As String
格納フォルダ = 格納フォルダ_
End Property
'「検索追加ワード」というプロパティの設定プロシージャ
Property Let 検索追加ワード(ByVal new_検索追加ワード As String)
検索追加ワード_ = new_検索追加ワード
End Property
'「検索追加ワード」というプロパティの取得プロシージャ
Property Get 検索追加ワード() As String
検索追加ワード = 検索追加ワード_
End Property
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
VBA使用頻度の高いコード（１４）：同一ファイルがある場合 日付のついた別名ファイルで保存する
同一ファイルがある場合 日付のついた別名ファイルで保存する
同一ファイルがある場合 日付のついた別名ファイルで保存する。以外に使います。自分の場合、上書き保存嫌うところがあって、万が一に備え別名で記録しているので重宝しています。
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub 別名保存()
Dim Target As String
'フォルダ格納設定⇒JPGで格納
Target = TargetFolder & "\" & Range("k" & i) & ".jpg"
If Dir(Target, vbDirectory) = "" Then
'フォルダ内に重複名がない場合ファイルがない場合そのまま作成
Else
'フォルダ内に重複名がある場合ファイル名に時間とタグをがない場合日時データを付与して複製保存
Target = TargetFolder & "\" & Range("k" & i) & "_" & Format(DateValue, "yyyymmddhhnnss") & "_同名格納" & ".jpg"
End If
FileCopy FilePath, Target
End Sub
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
VBA使用頻度の高いコード（１３）：Exif情報読込２（GPSExifReaderのクラスモジュールを使った場合）
Exif情報読込２（GPSExifReaderのクラスモジュールを使った場合）
Exif情報読込２（GPSExifReaderのクラスモジュールを使った場合）です。Access用GPSクラスモジュールが必要です。（以下のサイトからダウンロード）
使い方は以下のサイト
Excel(VBA)でJPGファイルのExif情報を読み込む – FRONT
Excelで使い場合はインスタンスの呼び出しが必要になります。
以下のコードはリスト上の写真から緯度経度情報を一括で記述するコードです。
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub 入力準備()
'写真情報取込み出力
On Error Resume Next ' エラー時は強制で次に以降
Dim ER '＜－－インスタンス Exif用クラスより入手
Dim ctRow, i As Long
Dim nameID, pkupDate, ckDate, ckDate1 As String
Dim nameArea, nameFolder, pkupArea, ckCategory As String
Dim pkupLon, pkupLat
'名前初期値
nameID = Range("C8")
'GPSクラスインスタンス格納
Set ER = New GPSExifReader
For ctRow = 10 To 20000
FilePath = Range("B" & ctRow)
If (FilePath = "") Then
Exit For
End If
i = i + 1
Range("C" & ctRow) = nameID & i '画像ID
pkupDate = ""
If (Range("A" & ctRow) = "") Then 'チェック欄空欄でのときのみ処理
With ER.Openfile(FilePath) '画像より情報抽出
Range("D" & ctRow) = .DateTimeOriginal '日時
pkupDate = .DateTimeOriginal
ckDate = Replace(pkupDate, ":", "")
ckDate1 = Replace(ckDate, " ", "")
If (ckDate1 = "") Then '日時→日付のみ抽出
Range("G" & ctRow) = "日付無"
Else
Range("G" & ctRow) = Left(ckDate, 8)
End If
Range("E" & ctRow) = .GPSLatitudeDecimal '緯度
Range("F" & ctRow) = .GPSLongitudeDecimal '経度
End With '緯度経度データからエリア作成⇒指定誤差範囲
If (Range("K" & ctRow) = "") Then '事前に入っている値を優先する
If (Range("E" & ctRow) = "" Or Range("F" & ctRow) = "") Then
Range("H" & ctRow) = "地域無" '緯度経度データない場合事前に「地域無」代入
Range("K" & ctRow) = Right(Range("G" & ctRow), 4) & "_" & Range("C" & ctRow) & "_無_無" 'ファイル名⇒日時(4桁)_ID_無_無.jpg
ActiveSheet.Hyperlinks.Add Anchor:=Range("L" & ctRow), Address:="https://www.google.co.jp/maps,ScreenTip:=" & "緯地図", TextToDisplay:="https://www.google.co.jp/maps"
Else
Range("K" & ctRow) = Right(Range("G" & ctRow), 4) & "_" & Range("C" & ctRow) & "_" & Range("E" & ctRow) & "_" & Range("F" & ctRow) 'ファイル名⇒日時(4桁)_ID_緯度_経度.jpg
ActiveSheet.Hyperlinks.Add Anchor:=Range("L" & ctRow), Address:="https://www.google.co.jp/maps/@" & Range("E" & ctRow) & "," & Range("F" & ctRow) & ",72m/data=!3m1!1e3,ScreenTip:=" & Range("E" & ctRow) & "緯度" & Range("F" & ctRow) & "経度地図", TextToDisplay:="https://www.google.co.jp/maps/@" & Range("E" & ctRow) & "," & Range("F" & ctRow) & ",72m/data=!3m1!1e3"
End If
End If
End If
Next ctRow
ER = Nothing
End Sub
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
VBA使用頻度の高いコード（１２）：Exif情報読込１（WIAを使った場合）
Exif情報読込１（WIAを使った場合）
Exif情報読込１（WIAを使った場合）用コード
使う前の準備として、先にVBAエディタからツール⇒参照設定
⇒Windows Image Acquisitionにチェック入れてください
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub GetExifinfo()
Dim ObjWIA As Object '情報読込にはWIAライブラリを使用する
'初期化
ExifModify.Exif_info1 = ""
ExifModify.Exif_info2 = ""
ExifModify.Exif_info3 = ""
ExifModify.Exif_info4 = ""
ExifModify.Exif_info5 = ""
If (ExifModify.Exif_Path = "") Then
Exit Sub
End If
If (Dir(ExifModify.Exif_Path, vbDirectory) = "") Then
MsgBox "ファイルがありません"
Exit Sub
End If
Set ObjWIA = CreateObject("Wia.ImageFile")
ObjWIA.LoadFile ExifModify.Exif_Path
On Error Resume Next
For Each p In ObjWIA.Properties
i = i + 1
V_ID = p.PropertyID
If p.PropertyID = 2 Then
ExifModify.Exif_info3 = p.Value(1) + p.Value(2) / 60 + p.Value(3) / 3600 'ID=2=緯度
ElseIf p.PropertyID = 4 Then
ExifModify.Exif_info4 = p.Value(1) + p.Value(2) / 60 + p.Value(3) / 3600 'ID=4=経度
ElseIf p.PropertyID = 272 Then
ExifModify.Exif_info1 = p.Value 'ID=272＝カメラ型番
ElseIf p.PropertyID = 274 Then
ExifModify.Exif_info5 = p.Value 'ID=274＝回転方向
ElseIf p.PropertyID = 36867 Then
ExifModify.Exif_info2 = p.Value 'ID=36867＝撮影時間
End If
Next
On Error GoTo 0
Set ObjWIA = Nothing
End Sub
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
那覇市（２）：那覇～那覇空港 2018/12/3
沖縄からは12/３帰ってきました。日本47全都道府県制覇！を果たしたので、
次は、
全世界の国を回る！！
としたいところですがそれはまた次に(笑)
しかし、最近のニュースはなかなかにいろいろきな臭いですねえ・・・
ゴーン容疑者を10日に再逮捕する方針 報酬計約40億円の過少記載容疑 - ライブドアニュース
詐欺容疑で逮捕されたHuaweiのCFO 有罪なら30年以上の禁固刑も - ライブドアニュース
どーにも、別の力が働いてる気が仕方がない気がするが
撮影日：2018/12/3
撮影場所：那覇市（日本）
撮影者：taikobox
-
-
-
那覇空港側 航空自衛隊基地（12/8‐9 美ら島エアフェスタ）
【美ら島エアーフェスタ 2018】F-15 近代化改修機 機動飛行 耳をつんざくエンジンスタート!!! / Naha Air Show F-15 ENGINE START - 那覇空港
無事に帰ってきて思うのですが、今回宿代は3泊して実は3千円以下です。
泊まったのは以下の2つ、どちらも格安なのでオススメ＾＾。
VBA使用頻度の高いコード（１２）：セルに合わせてオブジェクト配置
セルに合わせてオブジェクト配置
セルに合わせてオブジェクト配置用コード
下のは矢印配置
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub セルに合わせて矢印オブジェクト配置()
Range("X" & WorkID).Select
cellLenght = Selection.Width
cellHeight = Selection.Height
barSize = workTerm
barLenght = cellLenght * workTerm
barID = Range("E" & WorkID)
barHeight = 0
If WorkID = 9 Then
ActiveSheet.Shapes.AddShape(msoShapeLeftRightArrow, Cells(WorkID, barPosition).Left, Cells(WorkID, barPosition).Top + cellHeight * 0.75, barLenght, cellHeight * 0.1).Select
Else
ActiveSheet.Shapes.AddShape(msoShapeRightArrow, Cells(WorkID, barPosition).Left, Cells(WorkID, barPosition).Top + cellHeight * 0.4, barLenght, cellHeight * 0.3).Select
End If
With Selection.ShapeRange
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(255, 255, 0)
.Line.ForeColor.RGB = RGB(255, 0, 0)
.Line.Weight = 0.5
.Name = "checkbar" & barID
End With
End Sub
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
