食っちゃ寝システムができるまで

「食っちゃ寝システム」ができるまでの、棚卸&備忘録です。

Python勉強(8):(続々)ここまでやってなんですが改めてさくらVPS初めからやり直し

さくらVPSにPython3インストール

 

⇒(続々)

ここまでやってなんですが改めてさくらVPS初めからやり直し
入門ガイド|VPS(仮想専用サーバー)はさくらインターネット

 

 

12)WordPress用データベース作成 

 なかなかphpMyAdminのインストールがうまくいかないので直接コマンドラインよりWordPress用のデータベース作成。

  [root@*******]# mysql -u root -p
  Enter password:
 
  MariaDB [(none)]> create database wordpressdb collate utf8mb4_general_ci;

  MariaDB [(none)]> exit

 

13)WordPressインストール 

 なかなかphpMyAdminのインストールがうまくいかないので直接コマンドラインよりWordPress用のデータベース作成。 

  ↓WordPressダウンロード

ja.wordpress.org

 

  ↓WordPressダウンロード

  直接、WordPressのサイトからダウンロードするため

  [root@*******]# cd /var/www/html
  [root@*******]# wget https://ja.wordpress.org/wordpress-5.0-ja.tar.gz

 でダウンロードし、

 以下の手順に従いインストール

knowledge.sakura.ad.jp

 

  インストールしたのだが、うまく起動せずコードのまま表示される

 なぜか調べたところ、PHPがうまくApacheに組み込まれていないこと判明

qiita.com

  上記サイトの内容に従い、

  再度、インストール

   [root@*******]# yum install php

 

 

f:id:taikobox:20181211233053p:plain

 

f:id:taikobox:20181211233446p:plain

PhpMyadminの動作も含め確認完了

 

 

 

 

メルボルン(2):メルボルン秋 2011/6/2

世界は、22ヵ国くらいは回ったとは思うのですが、

まだ行ってない方が圧倒的多いです・・・

当たり前といえば当たり前ですが、北半球と南半球では季節が逆転します。

頭ではわかってはいても実際行ってみると素直にびっくりするものです。

(同じようにびっくりしたのが緯度が高いところの夏は日がなかなか沈まないのにもびっくりしたが)

 

 

下は、メルボルンに6月に行った時です。あっちは秋からに冬に向かうところでした。

 

撮影日:2011/6/2

撮影場所:メルボルン(オーストラリア)

撮影者:taikobox

  1. メルボルン博物館側の公園

  2. の公園

  3. 街中

 

  行ってみないと、やってみないとわからないことだらけです。

 この歳になっても・・・・^^:


 

 

 

 

Python勉強(7):(続々)ここまでやってなんですが改めてさくらVPS初めからやり直し

さくらVPSにPython3インストール

 

⇒(続々)

ここまでやってなんですが改めてさくらVPS初めからやり直し
入門ガイド|VPS(仮想専用サーバー)はさくらインターネット

 

 

12)WordPress用データベース作成 

 なかなかphpMyAdminのインストールがうまくいかないので直接コマンドラインよりWordPress用のデータベース作成。

  [root@*******]# mysql -u root -p
  Enter password:
 
  MariaDB [(none)]> create database wordpressdb collate utf8mb4_general_ci;

  MariaDB [(none)]> exit

 

13)WordPressインストール 

 なかなかphpMyAdminのインストールがうまくいかないので直接コマンドラインよりWordPress用のデータベース作成。 

  ↓WordPressダウンロード

ja.wordpress.org

 

  ↓WordPressダウンロード

  直接、WordPressのサイトからダウンロードするため

  [root@*******]# cd /var/www/html
  [root@*******]# wget https://ja.wordpress.org/wordpress-5.0-ja.tar.gz

 でダウンロードし、

 以下の手順に従いインストール

knowledge.sakura.ad.jp

 

  インストールしたのだが、うまく起動せずコードのまま表示される

 なぜか調べたところ、PHPがうまくApacheに組み込まれていないこと判明

qiita.com

  上記サイトの内容に従い、

  再度、インストール

   [root@*******]# yum install php

 

 

f:id:taikobox:20181211233053p:plain

 

f:id:taikobox:20181211233446p:plain

PhpMyadminの動作も含め確認完了

 

 

 

 

Python勉強(6):(続)ここまでやってなんですが改めてさくらVPS初めからやり直し

さくらVPSにPython3インストール

 

⇒(続)

ここまでやってなんですが改めてさくらVPS初めからやり直し
入門ガイド|VPS(仮想専用サーバー)はさくらインターネット

 

 

9)HTML/PHPの動作確認 

 PHPはスタートアップ時点でインストールされているので動作確認のみ。

 アップデート用のSFTPソフト「WinSCP」使い、出力用ミニプログラムを準備⇒アップロードして動作確認。

 (改め知ったことだがFTPって今はあまり使わないんですね・・・) 

 

f:id:taikobox:20181209104457p:plain

テスト用サンプルファイル作成

 

f:id:taikobox:20181209113911p:plain

WinSCPにてアップロード(PuTTyWinSCPから立ち上げています)

index.html⇒確認

f:id:taikobox:20181209115914p:plain

test.html(php記述)⇒確認

f:id:taikobox:20181209123711p:plain

 

10)データベース設定 

 8)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】ERROR 1045 の対処法 - Qiita

  上記に従い、権限再設定しようとしたのですがうまく行かず...

  調べると設定そのものしてないのではところで

 

 ↓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;

  うまくいきました

 

11SSL証明書用に Let’s Encryptをインストール

  ↓事前確認

  [root@*******]# httpd -M 

  f:id:taikobox:20181209150931p:plain 

  SSLモジュール確認

 

  [root@*******]# firewall-cmd --list-all

  f:id:taikobox:20181209151211p:plain

  ファイヤウォールのhttpsのアクティブ確認

 

 ↓ Let’s Encryptをインストール

   [root@****** ~]# yum install certbot python2-certbot-apache

 

SSLSecure Sockets Layerの

インターネット上で情報を暗号化し安全な通信を提供するプロトコル

Let’s Encrypt

Let's Encryptは、すべてのWebサーバへの接続を暗号化することを目指したプロジェクト。

2016年4月に正式に開始された認証局である。自動化された発行プロセスにより、TLSのX.509証明書の発行を無料で行っている。

 

ssl.sakura.ad.jp

   ↓ 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. 

  ポート80が見つからないとの事。方法探ると以下のサイト見つかったので

 

Let’s Encryptのインストールができない。途中で止まる時の対処法

  ↓上記内容より、実行(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

 

      f:id:taikobox:20181210065514p:plain

今日、データーベースのブラウザアクセス可能にしてWordPressインストールそのうえでPythonのミニプログラム動かして完成! 

⇒(続々)

 

 

 

 

 

 

 

 

 

那覇市(2):那覇~那覇空港 2018/12/3

沖縄からは12/3帰ってきました。日本47全都道府県制覇!を果たしたので、

次は、

全世界の国を回る!!

としたいところですがそれはまた次に(笑)

しかし、最近のニュースはなかなかにいろいろきな臭いですねえ・・・

ゴーン容疑者を10日に再逮捕する方針 報酬計約40億円の過少記載容疑 - ライブドアニュース

詐欺容疑で逮捕されたHuaweiのCFO 有罪なら30年以上の禁固刑も - ライブドアニュース

どーにも、別の力が働いてる気が仕方がない気がするが

 

 

 

 

撮影日:2018/12/3

撮影場所:那覇市(日本)

撮影者:taikobox

  1. 牧志公設市場国際通り

  2. 那覇国際通り那覇空港(歩き)

  3. 那覇空港側 航空自衛隊基地(12/8‐9 美ら島エアフェスタ)


    【美ら島エアーフェスタ 2018】F-15 近代化改修機 機動飛行 耳をつんざくエンジンスタート!!! / Naha Air Show F-15 ENGINE START

  4. 那覇空港

 

無事に帰ってきて思うのですが、今回宿代は3泊して実は3千円以下です。

泊まったのは以下の2つ、どちらも格安なのでオススメ^^。

www.booking.com

www.camcam-okinawa.com

 

 


 

 

 

 

「食っちゃ寝システム第一弾」(5):写真Exif編集アプリver500(3)

「食っちゃ寝システム第一弾」(5):中間報告

 

②写真のExif情報確認/編集

写真Exif編集アプリver500は読出した写真をExif情報確認/編集機能つけました

 

f:id:taikobox:20181209163344p:plain

 

1)プログラムの動作説明

f:id:taikobox:20181209163430p:plain

ここに関しては、練習用にWIAを使ってみました。

WIA=Windows Image Acquisition

直訳通り、ウィンドウズのイメージ取得用のオブジェクトで

歴史は意外に古くWindowsME(2000年から)ある機能です

Wia object - Windows applications | Microsoft Docs

Windows Image Acquisition - Wikipedia

niwakan.blogspot.com

 

 使う前の準備として、先にVBAエディタからツール⇒参照設定

Windows Image Acquisitionにチェック入れてください

f:id:taikobox:20181209164048p:plain

 

尚、Exif編集に関しては、今回は自分で作らず。フリーウェア「F6Exif」をコマンドラインで値渡し起動させることで一応対応しています。(縮小専用を外部操作するのと同じ手法です)そのため事前にF6Exif.exeを同一フォルダに格納しています
*コードとしては以下の部分で対応しています
 Res = Shell(ThisWorkbook.Path & "\F6Exif.exe" & ExifTarget, vbNormalFocus)

Exif確認編集部のコード>

===========================================

 

 


Private Sub Exif_Com1_Click()
Dim MapURL As String
MapURL = "https://www.google.co.jp/maps/@" & ExifModify.Exif_info3 & "," & ExifModify.Exif_info4 & ",72m/data=!3m1!1e3"
Call IEOpen(MapURL)
End Sub

Private Sub Exif_Com2_Click()
Dim ckExifEdit, ckExif_Camera, ckExif_Date, ckExif_Lat, ckExif_Lon, ckExif_Rotate
Dim overwriteExif

'Exif情報 変更ある場合は変更後⇒exif情報読込
ckExifEdit = ExifModify.Exif_edit1.Value & ExifModify.Exif_edit2.Value & ExifModify.Exif_edit3.Value & ExifModify.Exif_edit4.Value & ExifModify.Exif_edit5.Value
If (ckExifEdit = "") Then
'そのままexif情報読込
Else
'Exiftool通じて上書き
If (ExifModify.Exif_edit2.Value <> "") Then
Exiftooldate = " " & "-overwrite_original -MediaCreateDate='" & Exif_info2 & "' " & "-MediaModifyDate='" & ExifModify.Exif_edit2.Value & "' " & ExifModify.Exif_Path
End If


On Error Resume Next
MsgBox Exiftooldate
overwriteExif = Shell(ThisWorkbook.Path & "\exiftool.exe" & Exiftooldate, vbNormalFocus)
MsgBox overwriteExif
If Err.Number Then
MsgBox "Exiftool使えない環境です。別途Exif読取君開いてください。(変更内容に制限あります)"
Exit Sub
End If
On Error GoTo 0

End If

Call GetExifinfo

End Sub

Private Sub Exif_Com3_Click()
Unload ExifModify
End Sub

Private Sub Exif_Import_Click()
If (ExifModify.Exif_Path = "") Then

End If

ExifModify.Exif_Image.Picture = LoadPicture(FilePath)
End Sub

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
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

Private Sub OpenApp_Click()
Dim ExifTarget


On Error Resume Next
'この例ではBookと同じフォルダにShukuSen.exeがあります。
ExifTarget = " " & ExifModify.Exif_Path.Caption

Res = Shell(ThisWorkbook.Path & "\F6Exif.exe" & ExifTarget, vbNormalFocus)
If Err.Number Then
MsgBox "error"
Exit Sub
End If
On Error GoTo 0
End Sub

Private Sub UserForm_Initialize()
With ExifModify.Exif_edit5
.AddItem "1"
.AddItem "2"
.AddItem "3"
.AddItem "4"
.AddItem "5"
.AddItem "6"
.AddItem "7"
.AddItem "8"
.Value = ""
End With
Call Exif_Com2_Click

End Sub

 ====================================================

 

 ⇒写真Exif編集アプリver500(4)

「食っちゃ寝システム第一弾」(4):写真Exif編集アプリver500(2)

「食っちゃ寝システム第一弾」(4):中間報告

②自動分別した写真の確認

写真Exif編集アプリver500は読出した写真を実際開いて確認する機能も追加しました。

 

f:id:taikobox:20181209162737p:plain

 

1)プログラムの動作説明

f:id:taikobox:20181209162426p:plain

これに関して、特別な工夫はなくフォーム上にイメージを12個起き、12個ずつ表示切り替え確認出来るようにしたものです。これに関して新しく学んだことはないのですが。もっと軽く動作できるようにしていくこと思案中です。

 

 

<写真確認部のコード>

 

===========================================

 

 


Private Sub ckPhotoPath_1_Click()
Dim ckReuse, oldName, newName As String
oldName = ""
newName = ""
ckReuse = MsgBox("元のファイル名利用しますか?", vbYesNoCancel)
oldName = Replace(ckFolder.ckPhotoPath_1, ".jpg", "")

If (ckReuse = vbCancel) Then
ElseIf (ckReuse = vbYes) Then
MsgBox "元ファイル名" & oldName & "_をコピーします"
newName = oldName & "_.jpg"
Else
If (ckFolder.CoWordReName_2.Value = True) Then
newName = ckFolder.CoWordReName_1 & ckFolder.CoWordReName_3 & ".jpg"
ckFolder.CoWordReName_3 = ckFolder.CoWordReName_3 + 1
Else
newName = ckFolder.CoWordReName_1 & ".jpg"
End If
End If
ckFolder.Rename_1 = newName

End Sub

Private Sub ckPhotoPath_2_Click()
Dim ckReuse, oldName, newName As String
oldName = ""
newName = ""
ckReuse = MsgBox("元のファイル名利用しますか?", vbYesNoCancel)
oldName = Replace(ckFolder.ckPhotoPath_2, ".jpg", "")

If (ckReuse = vbCancel) Then
ElseIf (ckReuse = vbYes) Then
MsgBox "元ファイル名" & oldName & "_をコピーします"
newName = oldName & "_.jpg"
Else
If (ckFolder.CoWordReName_2.Value = True) Then
newName = ckFolder.CoWordReName_1 & ckFolder.CoWordReName_3 & ".jpg"
ckFolder.CoWordReName_3 = ckFolder.CoWordReName_3 + 1
Else
newName = ckFolder.CoWordReName_1 & ".jpg"
End If
End If
ckFolder.Rename_2 = newName
End Sub

Private Sub ckPhotoPath_3_Click()
Dim ckReuse, oldName, newName As String
oldName = ""
newName = ""
ckReuse = MsgBox("元のファイル名利用しますか?", vbYesNoCancel)
oldName = Replace(ckFolder.ckPhotoPath_3, ".jpg", "")

If (ckReuse = vbCancel) Then
ElseIf (ckReuse = vbYes) Then
MsgBox "元ファイル名" & oldName & "_をコピーします"
newName = oldName & "_.jpg"
Else
If (ckFolder.CoWordReName_2.Value = True) Then
newName = ckFolder.CoWordReName_1 & ckFolder.CoWordReName_3 & ".jpg"
ckFolder.CoWordReName_3 = ckFolder.CoWordReName_3 + 1
Else
newName = ckFolder.CoWordReName_1 & ".jpg"
End If
End If
ckFolder.Rename_3 = newName
End Sub

Private Sub ckPhotoPath_4_Click()
Dim ckReuse, oldName, newName As String
oldName = ""
newName = ""
ckReuse = MsgBox("元のファイル名利用しますか?", vbYesNoCancel)
oldName = Replace(ckFolder.ckPhotoPath_4, ".jpg", "")

If (ckReuse = vbCancel) Then
ElseIf (ckReuse = vbYes) Then
MsgBox "元ファイル名" & oldName & "_をコピーします"
newName = oldName & "_.jpg"
Else
If (ckFolder.CoWordReName_2.Value = True) Then
newName = ckFolder.CoWordReName_1 & ckFolder.CoWordReName_3 & ".jpg"
ckFolder.CoWordReName_3 = ckFolder.CoWordReName_3 + 1
Else
newName = ckFolder.CoWordReName_1 & ".jpg"
End If
End If
ckFolder.Rename_4 = newName
End Sub

Private Sub ckPhotoPath_5_Click()
Dim ckReuse, oldName, newName As String
oldName = ""
newName = ""
ckReuse = MsgBox("元のファイル名利用しますか?", vbYesNoCancel)
oldName = Replace(ckFolder.ckPhotoPath_5, ".jpg", "")

If (ckReuse = vbCancel) Then
ElseIf (ckReuse = vbYes) Then
MsgBox "元ファイル名" & oldName & "_をコピーします"
newName = oldName & "_.jpg"
Else
If (ckFolder.CoWordReName_2.Value = True) Then
newName = ckFolder.CoWordReName_1 & ckFolder.CoWordReName_3 & ".jpg"
ckFolder.CoWordReName_3 = ckFolder.CoWordReName_3 + 1
Else
newName = ckFolder.CoWordReName_1 & ".jpg"
End If
End If
ckFolder.Rename_5 = newName
End Sub

Private Sub ckPhotoPath_6_Click()
Dim ckReuse, oldName, newName As String
oldName = ""
newName = ""
ckReuse = MsgBox("元のファイル名利用しますか?", vbYesNoCancel)
oldName = Replace(ckFolder.ckPhotoPath_6, ".jpg", "")

If (ckReuse = vbCancel) Then
ElseIf (ckReuse = vbYes) Then
MsgBox "元ファイル名" & oldName & "_をコピーします"
newName = oldName & "_.jpg"
Else
If (ckFolder.CoWordReName_2.Value = True) Then
newName = ckFolder.CoWordReName_1 & ckFolder.CoWordReName_3 & ".jpg"
ckFolder.CoWordReName_3 = ckFolder.CoWordReName_3 + 1
Else
newName = ckFolder.CoWordReName_1 & ".jpg"
End If
End If
ckFolder.Rename_6 = newName
End Sub

Private Sub ckPhotoPath_7_Click()
Dim ckReuse, oldName, newName As String
oldName = ""
newName = ""
ckReuse = MsgBox("元のファイル名利用しますか?", vbYesNoCancel)
oldName = Replace(ckFolder.ckPhotoPath_7, ".jpg", "")

If (ckReuse = vbCancel) Then
ElseIf (ckReuse = vbYes) Then
MsgBox "元ファイル名" & oldName & "_をコピーします"
newName = oldName & "_.jpg"
Else
If (ckFolder.CoWordReName_2.Value = True) Then
newName = ckFolder.CoWordReName_1 & ckFolder.CoWordReName_3 & ".jpg"
ckFolder.CoWordReName_3 = ckFolder.CoWordReName_3 + 1
Else
newName = ckFolder.CoWordReName_1 & ".jpg"
End If
End If
ckFolder.Rename_7 = newName
End Sub

Private Sub ckPhotoPath_8_Click()
Dim ckReuse, oldName, newName As String
oldName = ""
newName = ""
ckReuse = MsgBox("元のファイル名利用しますか?", vbYesNoCancel)
oldName = Replace(ckFolder.ckPhotoPath_8, ".jpg", "")

If (ckReuse = vbCancel) Then
ElseIf (ckReuse = vbYes) Then
MsgBox "元ファイル名" & oldName & "_をコピーします"
newName = oldName & "_.jpg"
Else
If (ckFolder.CoWordReName_2.Value = True) Then
newName = ckFolder.CoWordReName_1 & ckFolder.CoWordReName_3 & ".jpg"
ckFolder.CoWordReName_3 = ckFolder.CoWordReName_3 + 1
Else
newName = ckFolder.CoWordReName_1 & ".jpg"
End If
End If
ckFolder.Rename_8 = newName
End Sub

Private Sub ckPhotoPath_9_Click()
Dim ckReuse, oldName, newName As String
oldName = ""
newName = ""
ckReuse = MsgBox("元のファイル名利用しますか?", vbYesNoCancel)
oldName = Replace(ckFolder.ckPhotoPath_9, ".jpg", "")

If (ckReuse = vbCancel) Then
ElseIf (ckReuse = vbYes) Then
MsgBox "元ファイル名" & oldName & "_をコピーします"
newName = oldName & "_.jpg"
Else
If (ckFolder.CoWordReName_2.Value = True) Then
newName = ckFolder.CoWordReName_1 & ckFolder.CoWordReName_3 & ".jpg"
ckFolder.CoWordReName_3 = ckFolder.CoWordReName_3 + 1
Else
newName = ckFolder.CoWordReName_1 & ".jpg"
End If
End If
ckFolder.Rename_9 = newName
End Sub

Private Sub ckPhotoPath_10_Click()
Dim ckReuse, oldName As String
oldName = ""
ckReuse = MsgBox("元のファイル名利用しますか?", vbYesNoCancel)
oldName = Replace(ckFolder.ckPhotoPath_10, ".jpg", "")
If (ckReuse = vbCancel) Then
ElseIf (ckReuse = vbYes) Then
MsgBox "元ファイル名" & oldName & "_をコピーします"
ckFolder.Rename_1 = oldName & "_.jpg"
Else
If (ckFolder.CoWordReName_2.Value = True) Then
ckFolder.Rename_1 = ckFolder.CoWordReName_1 & ckFolder.CoWordReName_3 & ".jpg"
ckFolder.CoWordReName_3 = ckFolder.CoWordReName_3 + 1
Else
ckFolder.Rename_10 = ckFolder.CoWordReName_1 & ".jpg"
End If
End If
End Sub

Private Sub ckPhotoPath_11_Click()
Dim ckReuse, oldName, newName As String
oldName = ""
newName = ""
ckReuse = MsgBox("元のファイル名利用しますか?", vbYesNoCancel)
oldName = Replace(ckFolder.ckPhotoPath_11, ".jpg", "")

If (ckReuse = vbCancel) Then
ElseIf (ckReuse = vbYes) Then
MsgBox "元ファイル名" & oldName & "_をコピーします"
newName = oldName & "_.jpg"
Else
If (ckFolder.CoWordReName_2.Value = True) Then
newName = ckFolder.CoWordReName_1 & ckFolder.CoWordReName_3 & ".jpg"
ckFolder.CoWordReName_3 = ckFolder.CoWordReName_3 + 1
Else
newName = ckFolder.CoWordReName_1 & ".jpg"
End If
End If
ckFolder.Rename_11 = newName
End Sub

Private Sub ckPhotoPath_12_Click()
Dim ckReuse, oldName, newName As String
oldName = ""
newName = ""
ckReuse = MsgBox("元のファイル名利用しますか?", vbYesNoCancel)
oldName = Replace(ckFolder.ckPhotoPath_12, ".jpg", "")

If (ckReuse = vbCancel) Then
ElseIf (ckReuse = vbYes) Then
MsgBox "元ファイル名" & oldName & "_をコピーします"
newName = oldName & "_.jpg"
Else
If (ckFolder.CoWordReName_2.Value = True) Then
newName = ckFolder.CoWordReName_1 & ckFolder.CoWordReName_3 & ".jpg"
ckFolder.CoWordReName_3 = ckFolder.CoWordReName_3 + 1
Else
newName = ckFolder.CoWordReName_1 & ".jpg"
End If
End If
ckFolder.Rename_12 = newName
End Sub

Private Sub CloseButton_Click()
Unload ckFolder
End Sub

Private Sub Folder1_Click()
Dim LoadFile As String
Dim GetFilePath As String
LoadFile = MsgBox("新規ファイル読込みます", vbOKCancel)
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)
End Sub

 

Private Sub cmShowPhoto_Click()
Dim LoadPhotos As String

LoadPhotos = MsgBox("写真読込表示します", vbYesNoCancel)


'読み込みデータの初期化
ckFolder.ckPhotoPath_1 = ""
ckFolder.ckPhotoPath_2 = ""
ckFolder.ckPhotoPath_3 = ""
ckFolder.ckPhotoPath_4 = ""
ckFolder.ckPhotoPath_5 = ""
ckFolder.ckPhotoPath_6 = ""
ckFolder.ckPhotoPath_7 = ""
ckFolder.ckPhotoPath_8 = ""
ckFolder.ckPhotoPath_9 = ""
ckFolder.ckPhotoPath_10 = ""
ckFolder.ckPhotoPath_11 = ""
ckFolder.ckPhotoPath_12 = ""

ckFolder.Rename_1 = ""
ckFolder.Rename_2 = ""
ckFolder.Rename_3 = ""
ckFolder.Rename_4 = ""
ckFolder.Rename_5 = ""
ckFolder.Rename_6 = ""
ckFolder.Rename_7 = ""
ckFolder.Rename_8 = ""
ckFolder.Rename_9 = ""
ckFolder.Rename_10 = ""
ckFolder.Rename_11 = ""
ckFolder.Rename_12 = ""

ckFolder.ckPhotoImage_1.Picture = LoadPicture("")
ckFolder.ckPhotoImage_2.Picture = LoadPicture("")
ckFolder.ckPhotoImage_3.Picture = LoadPicture("")
ckFolder.ckPhotoImage_4.Picture = LoadPicture("")
ckFolder.ckPhotoImage_5.Picture = LoadPicture("")
ckFolder.ckPhotoImage_6.Picture = LoadPicture("")
ckFolder.ckPhotoImage_7.Picture = LoadPicture("")
ckFolder.ckPhotoImage_8.Picture = LoadPicture("")
ckFolder.ckPhotoImage_9.Picture = LoadPicture("")
ckFolder.ckPhotoImage_10.Picture = LoadPicture("")
ckFolder.ckPhotoImage_11.Picture = LoadPicture("")
ckFolder.ckPhotoImage_12.Picture = LoadPicture("")

ckFolder.ckConfirm_1 = False
ckFolder.ckConfirm_2 = False
ckFolder.ckConfirm_3 = False
ckFolder.ckConfirm_4 = False
ckFolder.ckConfirm_5 = False
ckFolder.ckConfirm_6 = False
ckFolder.ckConfirm_7 = False
ckFolder.ckConfirm_8 = False
ckFolder.ckConfirm_9 = False
ckFolder.ckConfirm_10 = False
ckFolder.ckConfirm_11 = False
ckFolder.ckConfirm_12 = False



End Sub


Private Sub Folder_1_Click()


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
'読み込みデータの初期化
ckFolder.ckPhotoPath_1 = ""
ckFolder.ckPhotoPath_2 = ""
ckFolder.ckPhotoPath_3 = ""
ckFolder.ckPhotoPath_4 = ""
ckFolder.ckPhotoPath_5 = ""
ckFolder.ckPhotoPath_6 = ""
ckFolder.ckPhotoPath_7 = ""
ckFolder.ckPhotoPath_8 = ""
ckFolder.ckPhotoPath_9 = ""
ckFolder.ckPhotoPath_10 = ""
ckFolder.ckPhotoPath_11 = ""
ckFolder.ckPhotoPath_12 = ""

ckFolder.Rename_1 = ""
ckFolder.Rename_2 = ""
ckFolder.Rename_3 = ""
ckFolder.Rename_4 = ""
ckFolder.Rename_5 = ""
ckFolder.Rename_6 = ""
ckFolder.Rename_7 = ""
ckFolder.Rename_8 = ""
ckFolder.Rename_9 = ""
ckFolder.Rename_10 = ""
ckFolder.Rename_11 = ""
ckFolder.Rename_12 = ""

ckFolder.ckPhotoImage_1.Picture = LoadPicture("")
ckFolder.ckPhotoImage_2.Picture = LoadPicture("")
ckFolder.ckPhotoImage_3.Picture = LoadPicture("")
ckFolder.ckPhotoImage_4.Picture = LoadPicture("")
ckFolder.ckPhotoImage_5.Picture = LoadPicture("")
ckFolder.ckPhotoImage_6.Picture = LoadPicture("")
ckFolder.ckPhotoImage_7.Picture = LoadPicture("")
ckFolder.ckPhotoImage_8.Picture = LoadPicture("")
ckFolder.ckPhotoImage_9.Picture = LoadPicture("")
ckFolder.ckPhotoImage_10.Picture = LoadPicture("")
ckFolder.ckPhotoImage_11.Picture = LoadPicture("")
ckFolder.ckPhotoImage_12.Picture = LoadPicture("")

ckFolder.ckConfirm_1 = False
ckFolder.ckConfirm_2 = False
ckFolder.ckConfirm_3 = False
ckFolder.ckConfirm_4 = False
ckFolder.ckConfirm_5 = False
ckFolder.ckConfirm_6 = False
ckFolder.ckConfirm_7 = False
ckFolder.ckConfirm_8 = False
ckFolder.ckConfirm_9 = False
ckFolder.ckConfirm_10 = False
ckFolder.ckConfirm_11 = False
ckFolder.ckConfirm_12 = False


End Sub

Private Sub GotoBack_Click()

On Error GoTo Skip
'読み込みデータの初期化
ckFolder.ckPhotoPath_1 = ""
ckFolder.ckPhotoPath_2 = ""
ckFolder.ckPhotoPath_3 = ""
ckFolder.ckPhotoPath_4 = ""
ckFolder.ckPhotoPath_5 = ""
ckFolder.ckPhotoPath_6 = ""
ckFolder.ckPhotoPath_7 = ""
ckFolder.ckPhotoPath_8 = ""
ckFolder.ckPhotoPath_9 = ""
ckFolder.ckPhotoPath_10 = ""
ckFolder.ckPhotoPath_11 = ""
ckFolder.ckPhotoPath_12 = ""

ckFolder.Rename_1 = ""
ckFolder.Rename_2 = ""
ckFolder.Rename_3 = ""
ckFolder.Rename_4 = ""
ckFolder.Rename_5 = ""
ckFolder.Rename_6 = ""
ckFolder.Rename_7 = ""
ckFolder.Rename_8 = ""
ckFolder.Rename_9 = ""
ckFolder.Rename_10 = ""
ckFolder.Rename_11 = ""
ckFolder.Rename_12 = ""

ckFolder.ckPhotoImage_1.Picture = LoadPicture("")
ckFolder.ckPhotoImage_2.Picture = LoadPicture("")
ckFolder.ckPhotoImage_3.Picture = LoadPicture("")
ckFolder.ckPhotoImage_4.Picture = LoadPicture("")
ckFolder.ckPhotoImage_5.Picture = LoadPicture("")
ckFolder.ckPhotoImage_6.Picture = LoadPicture("")
ckFolder.ckPhotoImage_7.Picture = LoadPicture("")
ckFolder.ckPhotoImage_8.Picture = LoadPicture("")
ckFolder.ckPhotoImage_9.Picture = LoadPicture("")
ckFolder.ckPhotoImage_10.Picture = LoadPicture("")
ckFolder.ckPhotoImage_11.Picture = LoadPicture("")
ckFolder.ckPhotoImage_12.Picture = LoadPicture("")

ckFolder.ckConfirm_1 = False
ckFolder.ckConfirm_2 = False
ckFolder.ckConfirm_3 = False
ckFolder.ckConfirm_4 = False
ckFolder.ckConfirm_5 = False
ckFolder.ckConfirm_6 = False
ckFolder.ckConfirm_7 = False
ckFolder.ckConfirm_8 = False
ckFolder.ckConfirm_9 = False
ckFolder.ckConfirm_10 = False
ckFolder.ckConfirm_11 = False
ckFolder.ckConfirm_12 = False

If (ckFolder.ctFile_1 = "") Then
ckFolder.ctFile_1 = 1
If (ckFolder.ctFile_3 > 12) Then
ckFolder.ctFile_2 = 12
Else
ckFolder.ctFile_2 = ckFolder.ctFile_3
End If
ElseIf (ckFolder.ctFile_1 - 12 < 1 And ckFolder.ctFile_2 = ckFolder.ctFile_3) Then
MsgBox "フォルダ内ファイル数は" & ckFolder.ctFile_3 & "です"
ElseIf (ckFolder.ctFile_1 - 12 > 1 And ckFolder.ctFile_2 = ckFolder.ctFile_3) Then
ckFolder.ctFile_1 = ckFolder.ctFile_1 - 12
ckFolder.ctFile_2 = ckFolder.ctFile_1 + 11
ElseIf (ckFolder.ctFile_1 - 12 > 1 And ckFolder.ctFile_2 = ckFolder.ctFile_1 + 11) Then
ckFolder.ctFile_1 = ckFolder.ctFile_1 - 12
ckFolder.ctFile_2 = ckFolder.ctFile_2 - 12
ElseIf (ckFolder.ctFile_1 - 12 = 1 And ckFolder.ctFile_2 = ckFolder.ctFile_1 + 11) Then
ckFolder.ctFile_1 = ckFolder.ctFile_1 - 12
ckFolder.ctFile_2 = ckFolder.ctFile_2 - 12
ElseIf (ckFolder.ctFile_1 - 12 = 1 And ckFolder.ctFile_2 = ckFolder.ctFile_3) Then
ckFolder.ctFile_1 = ckFolder.ctFile_1 - 12
ckFolder.ctFile_2 = ckFolder.ctFile_1 + 11
End If

On Error Resume Next
j = 0
For i = ckFolder.ctFile_1 - 1 To ckFolder.ctFile_2 - 1
j = j + 1
fPath = Folder_1 & "\" & ckFolder.FileList.List(i)
Me.Controls("ckPhotoPath_" & j) = ckFolder.FileList.List(i)
Me.Controls("ckPhotoImage_" & j).Picture = LoadPicture(fPath)
Next i

'リストボックス内検索
If ckFolder.ckPhotoPath_1.Caption = "" Then Exit Sub
For i = 0 To FileList.ListCount - 1
If ckFolder.FileList.List(i) = ckFolder.ckPhotoPath_1.Caption Then
ckFolder.FileList.ListIndex = i
Exit For
End If
Next i

 

Exit Sub
Skip:


End Sub

Private Sub GotoNext_Click()
Dim i, j, fPath

On Error GoTo Skip
ckFolder.ckPhotoPath_1 = ""
ckFolder.ckPhotoPath_2 = ""
ckFolder.ckPhotoPath_3 = ""
ckFolder.ckPhotoPath_4 = ""
ckFolder.ckPhotoPath_5 = ""
ckFolder.ckPhotoPath_6 = ""
ckFolder.ckPhotoPath_7 = ""
ckFolder.ckPhotoPath_8 = ""
ckFolder.ckPhotoPath_9 = ""
ckFolder.ckPhotoPath_10 = ""
ckFolder.ckPhotoPath_11 = ""
ckFolder.ckPhotoPath_12 = ""

ckFolder.Rename_1 = ""
ckFolder.Rename_2 = ""
ckFolder.Rename_3 = ""
ckFolder.Rename_4 = ""
ckFolder.Rename_5 = ""
ckFolder.Rename_6 = ""
ckFolder.Rename_7 = ""
ckFolder.Rename_8 = ""
ckFolder.Rename_9 = ""
ckFolder.Rename_10 = ""
ckFolder.Rename_11 = ""
ckFolder.Rename_12 = ""

ckFolder.ckPhotoImage_1.Picture = LoadPicture("")
ckFolder.ckPhotoImage_2.Picture = LoadPicture("")
ckFolder.ckPhotoImage_3.Picture = LoadPicture("")
ckFolder.ckPhotoImage_4.Picture = LoadPicture("")
ckFolder.ckPhotoImage_5.Picture = LoadPicture("")
ckFolder.ckPhotoImage_6.Picture = LoadPicture("")
ckFolder.ckPhotoImage_7.Picture = LoadPicture("")
ckFolder.ckPhotoImage_8.Picture = LoadPicture("")
ckFolder.ckPhotoImage_9.Picture = LoadPicture("")
ckFolder.ckPhotoImage_10.Picture = LoadPicture("")
ckFolder.ckPhotoImage_11.Picture = LoadPicture("")
ckFolder.ckPhotoImage_12.Picture = LoadPicture("")

ckFolder.ckConfirm_1 = False
ckFolder.ckConfirm_2 = False
ckFolder.ckConfirm_3 = False
ckFolder.ckConfirm_4 = False
ckFolder.ckConfirm_5 = False
ckFolder.ckConfirm_6 = False
ckFolder.ckConfirm_7 = False
ckFolder.ckConfirm_8 = False
ckFolder.ckConfirm_9 = False
ckFolder.ckConfirm_10 = False
ckFolder.ckConfirm_11 = False
ckFolder.ckConfirm_12 = False
If (ckFolder.ctFile_1 = "") Then
ckFolder.ctFile_1 = 1
If (ckFolder.ctFile_3 = "") Then
Exit Sub
ElseIf (ckFolder.ctFile_3 > 12) Then
ckFolder.ctFile_2 = 12
Else
ckFolder.ctFile_2 = ckFolder.ctFile_3
End If
ElseIf (ckFolder.ctFile_2 = "" And ckFolder.ctFile_3 = "") Then
MsgBox "フォルダ内ファイル数は0です"
ElseIf (ckFolder.ctFile_2 = ckFolder.ctFile_3) Then
MsgBox "フォルダ内ファイル数は" & ckFolder.ctFile_3 & "です"
ElseIf (ckFolder.ctFile_1 >= 1 And ckFolder.ctFile_2 + 12 < ckFolder.ctFile_3) Then
ckFolder.ctFile_1 = ckFolder.ctFile_1 + 12
ckFolder.ctFile_2 = ckFolder.ctFile_2 + 12
ElseIf (ckFolder.ctFile_1 >= 1 And ckFolder.ctFile_2 + 12 > ckFolder.ctFile_3) Then
ckFolder.ctFile_1 = ckFolder.ctFile_1 + 12
ckFolder.ctFile_2 = ckFolder.ctFile_3
End If

j = 0
For i = ckFolder.ctFile_1 - 1 To ckFolder.ctFile_2 - 1
j = j + 1
fPath = Folder_1 & "\" & ckFolder.FileList.List(i)
Me.Controls("ckPhotoPath_" & j) = ckFolder.FileList.List(i)
Me.Controls("ckPhotoImage_" & j).Picture = LoadPicture(fPath)

Next i

'リストボックス内検索
If ckFolder.ckPhotoPath_1.Caption = "" Then Exit Sub
For i = 0 To FileList.ListCount - 1
If ckFolder.FileList.List(i) = ckFolder.ckPhotoPath_1.Caption Then
ckFolder.FileList.ListIndex = i
Exit For
End If
Next i

 

Exit Sub
Skip:


End Sub


Private Sub GotoExif_1_Click()
If (ckFolder.ckPhotoPath_1 = "") Then
Exit Sub
End If


FilePath = ckFolder.Folder_1 & "\" & ckFolder.ckPhotoPath_1
If Dir(FilePath, vbDirectory) = "" Then
MsgBox "ファイルがありません"
Exit Sub
Else
ExifModify.Exif_Path = FilePath
ExifModify.Exif_Image.Picture = LoadPicture(FilePath)

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

ExifModify.Show
End If
End Sub

Private Sub GotoExif_2_Click()
If (ckFolder.ckPhotoPath_1 = "") Then
Exit Sub
End If


FilePath = ckFolder.Folder_1 & "\" & ckFolder.ckPhotoPath_2
If Dir(FilePath, vbDirectory) = "" Then
MsgBox "ファイルがありません"
Exit Sub
Else
ExifModify.Exif_Path = FilePath
ExifModify.Exif_Image.Picture = LoadPicture(FilePath)

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

ExifModify.Show
End If
End Sub

Private Sub GotoExif_3_Click()
If (ckFolder.ckPhotoPath_1 = "") Then
Exit Sub
End If


FilePath = ckFolder.Folder_1 & "\" & ckFolder.ckPhotoPath_3
If Dir(FilePath, vbDirectory) = "" Then
MsgBox "ファイルがありません"
Exit Sub
Else
ExifModify.Exif_Path = FilePath
ExifModify.Exif_Image.Picture = LoadPicture(FilePath)

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

ExifModify.Show
End If
End Sub

Private Sub GotoExif_4_Click()
If (ckFolder.ckPhotoPath_1 = "") Then
Exit Sub
End If


FilePath = ckFolder.Folder_1 & "\" & ckFolder.ckPhotoPath_4
If Dir(FilePath, vbDirectory) = "" Then
MsgBox "ファイルがありません"
Exit Sub
Else
ExifModify.Exif_Path = FilePath
ExifModify.Exif_Image.Picture = LoadPicture(FilePath)

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

ExifModify.Show
End If
End Sub

Private Sub GotoExif_5_Click()
If (ckFolder.ckPhotoPath_1 = "") Then
Exit Sub
End If


FilePath = ckFolder.Folder_1 & "\" & ckFolder.ckPhotoPath_5
If Dir(FilePath, vbDirectory) = "" Then
MsgBox "ファイルがありません"
Exit Sub
Else
ExifModify.Exif_Path = FilePath
ExifModify.Exif_Image.Picture = LoadPicture(FilePath)

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

ExifModify.Show
End If
End Sub

Private Sub GotoExif_6_Click()
If (ckFolder.ckPhotoPath_1 = "") Then
Exit Sub
End If


FilePath = ckFolder.Folder_1 & "\" & ckFolder.ckPhotoPath_6
If Dir(FilePath, vbDirectory) = "" Then
MsgBox "ファイルがありません"
Exit Sub
Else
ExifModify.Exif_Path = FilePath
ExifModify.Exif_Image.Picture = LoadPicture(FilePath)

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

ExifModify.Show
End If
End Sub

Private Sub GotoExif_7_Click()
If (ckFolder.ckPhotoPath_1 = "") Then
Exit Sub
End If


FilePath = ckFolder.Folder_1 & "\" & ckFolder.ckPhotoPath_7
If Dir(FilePath, vbDirectory) = "" Then
MsgBox "ファイルがありません"
Exit Sub
Else
ExifModify.Exif_Path = FilePath
ExifModify.Exif_Image.Picture = LoadPicture(FilePath)

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

ExifModify.Show
End If
End Sub

Private Sub GotoExif_8_Click()
If (ckFolder.ckPhotoPath_1 = "") Then
Exit Sub
End If


FilePath = ckFolder.Folder_1 & "\" & ckFolder.ckPhotoPath_8
If Dir(FilePath, vbDirectory) = "" Then
MsgBox "ファイルがありません"
Exit Sub
Else
ExifModify.Exif_Path = FilePath
ExifModify.Exif_Image.Picture = LoadPicture(FilePath)

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

ExifModify.Show
End If
End Sub

Private Sub GotoExif_9_Click()
If (ckFolder.ckPhotoPath_1 = "") Then
Exit Sub
End If


FilePath = ckFolder.Folder_1 & "\" & ckFolder.ckPhotoPath_9
If Dir(FilePath, vbDirectory) = "" Then
MsgBox "ファイルがありません"
Exit Sub
Else
ExifModify.Exif_Path = FilePath
ExifModify.Exif_Image.Picture = LoadPicture(FilePath)

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

ExifModify.Show
End If
End Sub
Private Sub GotoExif_10_Click()
If (ckFolder.ckPhotoPath_1 = "") Then
Exit Sub
End If


FilePath = ckFolder.Folder_1 & "\" & ckFolder.ckPhotoPath_10
If Dir(FilePath, vbDirectory) = "" Then
MsgBox "ファイルがありません"
Exit Sub
Else
ExifModify.Exif_Path = FilePath
ExifModify.Exif_Image.Picture = LoadPicture(FilePath)

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

ExifModify.Show
End If
End Sub
End Sub

Private Sub GotoExif_11_Click()
If (ckFolder.ckPhotoPath_1 = "") Then
Exit Sub
End If


FilePath = ckFolder.Folder_1 & "\" & ckFolder.ckPhotoPath_11
If Dir(FilePath, vbDirectory) = "" Then
MsgBox "ファイルがありません"
Exit Sub
Else
ExifModify.Exif_Path = FilePath
ExifModify.Exif_Image.Picture = LoadPicture(FilePath)

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

ExifModify.Show
End If
End Sub

Private Sub GotoExif_12_Click()
If (ckFolder.ckPhotoPath_1 = "") Then
Exit Sub
End If


FilePath = ckFolder.Folder_1 & "\" & ckFolder.ckPhotoPath_12
If Dir(FilePath, vbDirectory) = "" Then
MsgBox "ファイルがありません"
Exit Sub
Else
ExifModify.Exif_Path = FilePath
ExifModify.Exif_Image.Picture = LoadPicture(FilePath)

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

ExifModify.Show
End If
End Sub

 

Private Sub ReNew_Click()
Dim i As Integer
Dim oldPath, newFilename, newPath As String

'新規名称付け直したファイル複製(元ファイルは残します)

 

 

 

End Sub

Private Sub ReNewName_1_Click()
Dim ResultRename, FilePath, Target, TargetFolder, FileName As String
Dim DateValue As String

' 選択項目入力
ckRename = MsgBox("リネーム格納行います。", vbYesNo)

If (ckRename = vbYes) Then
Else
Exit Sub
End If

On Error Resume Next ' エラー時は強制で次に以降
DateValue = Date


'ファイル元パスがない場合終了
FileName = ckPhotoPath_1
FilePath = ckFolder.Folder_1 & "\" & ckPhotoPath_1
ResultRename = ckFolder.Rename_1
If (FileName = "") Then
Exit Sub
End If
If (ResultRename = "") Then
Exit Sub
End If
If (Right(ResultRename, 4) <> ".jpg") Then
MsgBox "拡張子がjpgではありません"
Exit Sub
End If
'フォルダ格納設定⇒JPGで格納
Target = ckFolder.Folder_1 & "\" & ResultRename
If Dir(Target, vbDirectory) = "" Then
'フォルダ内に重複名がない場合ファイルがない場合そのまま作成
Else
'フォルダ内に重複名がある場合ファイル名に時間とタグをがない場合日時データを付与して複製保存
Target = TargetFolder & "\" & Range("k" & i) & "_" & Format(DateValue, "yyyymmddhhnnss") & "_同名格納" & ".jpg"
End If
FileCopy FilePath, Target

 


End Sub

Private Sub ReNewName_2_Click()
Dim ResultRename, FilePath, Target, TargetFolder, FileName As String
Dim DateValue As String

' 選択項目入力
ckRename = MsgBox("リネーム格納行います。", vbYesNo)

If (ckRename = vbYes) Then
Else
Exit Sub
End If

On Error Resume Next ' エラー時は強制で次に以降
DateValue = Date


'ファイル元パスがない場合終了
FileName = ckPhotoPath_1
FilePath = ckFolder.Folder_1 & "\" & ckPhotoPath_2
ResultRename = ckFolder.Rename_2
If (FileName = "") Then
Exit Sub
End If
If (ResultRename = "") Then
Exit Sub
End If
If (Right(ResultRename, 4) <> ".jpg") Then
MsgBox "拡張子がjpgではありません"
Exit Sub
End If
'フォルダ格納設定⇒JPGで格納
Target = ckFolder.Folder_1 & "\" & ResultRename
If Dir(Target, vbDirectory) = "" Then
'フォルダ内に重複名がない場合ファイルがない場合そのまま作成
Else
'フォルダ内に重複名がある場合ファイル名に時間とタグをがない場合日時データを付与して複製保存
Target = TargetFolder & "\" & Range("k" & i) & "_" & Format(DateValue, "yyyymmddhhnnss") & "_同名格納" & ".jpg"
End If
FileCopy FilePath, Target
End Sub

Private Sub ReNewName_3_Click()
Dim ResultRename, FilePath, Target, TargetFolder, FileName As String
Dim DateValue As String

' 選択項目入力
ckRename = MsgBox("リネーム格納行います。", vbYesNo)

If (ckRename = vbYes) Then
Else
Exit Sub
End If

On Error Resume Next ' エラー時は強制で次に以降
DateValue = Date


'ファイル元パスがない場合終了
FileName = ckPhotoPath_1
FilePath = ckFolder.Folder_1 & "\" & ckPhotoPath_3
ResultRename = ckFolder.Rename_3
If (FileName = "") Then
Exit Sub
End If
If (ResultRename = "") Then
Exit Sub
End If
If (Right(ResultRename, 4) <> ".jpg") Then
MsgBox "拡張子がjpgではありません"
Exit Sub
End If
'フォルダ格納設定⇒JPGで格納
Target = ckFolder.Folder_1 & "\" & ResultRename
If Dir(Target, vbDirectory) = "" Then
'フォルダ内に重複名がない場合ファイルがない場合そのまま作成
Else
'フォルダ内に重複名がある場合ファイル名に時間とタグをがない場合日時データを付与して複製保存
Target = TargetFolder & "\" & Range("k" & i) & "_" & Format(DateValue, "yyyymmddhhnnss") & "_同名格納" & ".jpg"
End If
FileCopy FilePath, Target
End Sub

Private Sub ReNewName_4_Click()
Dim ResultRename, FilePath, Target, TargetFolder, FileName As String
Dim DateValue As String

' 選択項目入力
ckRename = MsgBox("リネーム格納行います。", vbYesNo)

If (ckRename = vbYes) Then
Else
Exit Sub
End If

On Error Resume Next ' エラー時は強制で次に以降
DateValue = Date


'ファイル元パスがない場合終了
FileName = ckPhotoPath_1
FilePath = ckFolder.Folder_1 & "\" & ckPhotoPath_4
ResultRename = ckFolder.Rename_4
If (FileName = "") Then
Exit Sub
End If
If (ResultRename = "") Then
Exit Sub
End If
If (Right(ResultRename, 4) <> ".jpg") Then
MsgBox "拡張子がjpgではありません"
Exit Sub
End If
'フォルダ格納設定⇒JPGで格納
Target = ckFolder.Folder_1 & "\" & ResultRename
If Dir(Target, vbDirectory) = "" Then
'フォルダ内に重複名がない場合ファイルがない場合そのまま作成
Else
'フォルダ内に重複名がある場合ファイル名に時間とタグをがない場合日時データを付与して複製保存
Target = TargetFolder & "\" & Range("k" & i) & "_" & Format(DateValue, "yyyymmddhhnnss") & "_同名格納" & ".jpg"
End If
FileCopy FilePath, Target
End Sub

Private Sub ReNewName_5_Click()
Dim ResultRename, FilePath, Target, TargetFolder, FileName As String
Dim DateValue As String

' 選択項目入力
ckRename = MsgBox("リネーム格納行います。", vbYesNo)

If (ckRename = vbYes) Then
Else
Exit Sub
End If

On Error Resume Next ' エラー時は強制で次に以降
DateValue = Date


'ファイル元パスがない場合終了
FileName = ckPhotoPath_1
FilePath = ckFolder.Folder_1 & "\" & ckPhotoPath_5
ResultRename = ckFolder.Rename_5
If (FileName = "") Then
Exit Sub
End If
If (ResultRename = "") Then
Exit Sub
End If
If (Right(ResultRename, 4) <> ".jpg") Then
MsgBox "拡張子がjpgではありません"
Exit Sub
End If
'フォルダ格納設定⇒JPGで格納
Target = ckFolder.Folder_1 & "\" & ResultRename
If Dir(Target, vbDirectory) = "" Then
'フォルダ内に重複名がない場合ファイルがない場合そのまま作成
Else
'フォルダ内に重複名がある場合ファイル名に時間とタグをがない場合日時データを付与して複製保存
Target = TargetFolder & "\" & Range("k" & i) & "_" & Format(DateValue, "yyyymmddhhnnss") & "_同名格納" & ".jpg"
End If
FileCopy FilePath, Target
End Sub

Private Sub ReNewName_6_Click()
Dim ResultRename, FilePath, Target, TargetFolder, FileName As String
Dim DateValue As String

' 選択項目入力
ckRename = MsgBox("リネーム格納行います。", vbYesNo)

If (ckRename = vbYes) Then
Else
Exit Sub
End If

On Error Resume Next ' エラー時は強制で次に以降
DateValue = Date


'ファイル元パスがない場合終了
FileName = ckPhotoPath_1
FilePath = ckFolder.Folder_1 & "\" & ckPhotoPath_6
ResultRename = ckFolder.Rename_6
If (FileName = "") Then
Exit Sub
End If
If (ResultRename = "") Then
Exit Sub
End If
If (Right(ResultRename, 4) <> ".jpg") Then
MsgBox "拡張子がjpgではありません"
Exit Sub
End If
'フォルダ格納設定⇒JPGで格納
Target = ckFolder.Folder_1 & "\" & ResultRename
If Dir(Target, vbDirectory) = "" Then
'フォルダ内に重複名がない場合ファイルがない場合そのまま作成
Else
'フォルダ内に重複名がある場合ファイル名に時間とタグをがない場合日時データを付与して複製保存
Target = TargetFolder & "\" & Range("k" & i) & "_" & Format(DateValue, "yyyymmddhhnnss") & "_同名格納" & ".jpg"
End If
FileCopy FilePath, Target
End Sub

Private Sub ReNewName_7_Click()
Dim ResultRename, FilePath, Target, TargetFolder, FileName As String
Dim DateValue As String

' 選択項目入力
ckRename = MsgBox("リネーム格納行います。", vbYesNo)

If (ckRename = vbYes) Then
Else
Exit Sub
End If

On Error Resume Next ' エラー時は強制で次に以降
DateValue = Date


'ファイル元パスがない場合終了
FileName = ckPhotoPath_1
FilePath = ckFolder.Folder_1 & "\" & ckPhotoPath_7
ResultRename = ckFolder.Rename_7
If (FileName = "") Then
Exit Sub
End If
If (ResultRename = "") Then
Exit Sub
End If
If (Right(ResultRename, 4) <> ".jpg") Then
MsgBox "拡張子がjpgではありません"
Exit Sub
End If
'フォルダ格納設定⇒JPGで格納
Target = ckFolder.Folder_1 & "\" & ResultRename
If Dir(Target, vbDirectory) = "" Then
'フォルダ内に重複名がない場合ファイルがない場合そのまま作成
Else
'フォルダ内に重複名がある場合ファイル名に時間とタグをがない場合日時データを付与して複製保存
Target = TargetFolder & "\" & Range("k" & i) & "_" & Format(DateValue, "yyyymmddhhnnss") & "_同名格納" & ".jpg"
End If
FileCopy FilePath, Target
End Sub

Private Sub ReNewName_8_Click()
Dim ResultRename, FilePath, Target, TargetFolder, FileName As String
Dim DateValue As String

' 選択項目入力
ckRename = MsgBox("リネーム格納行います。", vbYesNo)

If (ckRename = vbYes) Then
Else
Exit Sub
End If

On Error Resume Next ' エラー時は強制で次に以降
DateValue = Date


'ファイル元パスがない場合終了
FileName = ckPhotoPath_1
FilePath = ckFolder.Folder_1 & "\" & ckPhotoPath_8
ResultRename = ckFolder.Rename_8
If (FileName = "") Then
Exit Sub
End If
If (ResultRename = "") Then
Exit Sub
End If
If (Right(ResultRename, 4) <> ".jpg") Then
MsgBox "拡張子がjpgではありません"
Exit Sub
End If
'フォルダ格納設定⇒JPGで格納
Target = ckFolder.Folder_1 & "\" & ResultRename
If Dir(Target, vbDirectory) = "" Then
'フォルダ内に重複名がない場合ファイルがない場合そのまま作成
Else
'フォルダ内に重複名がある場合ファイル名に時間とタグをがない場合日時データを付与して複製保存
Target = TargetFolder & "\" & Range("k" & i) & "_" & Format(DateValue, "yyyymmddhhnnss") & "_同名格納" & ".jpg"
End If
FileCopy FilePath, Target
End Sub

Private Sub ReNewName_9_Click()
Dim ResultRename, FilePath, Target, TargetFolder, FileName As String
Dim DateValue As String

' 選択項目入力
ckRename = MsgBox("リネーム格納行います。", vbYesNo)

If (ckRename = vbYes) Then
Else
Exit Sub
End If

On Error Resume Next ' エラー時は強制で次に以降
DateValue = Date


'ファイル元パスがない場合終了
FileName = ckPhotoPath_1
FilePath = ckFolder.Folder_1 & "\" & ckPhotoPath_9
ResultRename = ckFolder.Rename_9
If (FileName = "") Then
Exit Sub
End If
If (ResultRename = "") Then
Exit Sub
End If
If (Right(ResultRename, 4) <> ".jpg") Then
MsgBox "拡張子がjpgではありません"
Exit Sub
End If
'フォルダ格納設定⇒JPGで格納
Target = ckFolder.Folder_1 & "\" & ResultRename
If Dir(Target, vbDirectory) = "" Then
'フォルダ内に重複名がない場合ファイルがない場合そのまま作成
Else
'フォルダ内に重複名がある場合ファイル名に時間とタグをがない場合日時データを付与して複製保存
Target = TargetFolder & "\" & Range("k" & i) & "_" & Format(DateValue, "yyyymmddhhnnss") & "_同名格納" & ".jpg"
End If
FileCopy FilePath, Target
End Sub

Private Sub ReNewName_10_Click()
Dim ResultRename, FilePath, Target, TargetFolder, FileName As String
Dim DateValue As String

' 選択項目入力
ckRename = MsgBox("リネーム格納行います。", vbYesNo)

If (ckRename = vbYes) Then
Else
Exit Sub
End If

On Error Resume Next ' エラー時は強制で次に以降
DateValue = Date


'ファイル元パスがない場合終了
FileName = ckPhotoPath_1
FilePath = ckFolder.Folder_1 & "\" & ckPhotoPath_10
ResultRename = ckFolder.Rename_10
If (FileName = "") Then
Exit Sub
End If
If (ResultRename = "") Then
Exit Sub
End If
If (Right(ResultRename, 4) <> ".jpg") Then
MsgBox "拡張子がjpgではありません"
Exit Sub
End If
'フォルダ格納設定⇒JPGで格納
Target = ckFolder.Folder_1 & "\" & ResultRename
If Dir(Target, vbDirectory) = "" Then
'フォルダ内に重複名がない場合ファイルがない場合そのまま作成
Else
'フォルダ内に重複名がある場合ファイル名に時間とタグをがない場合日時データを付与して複製保存
Target = TargetFolder & "\" & Range("k" & i) & "_" & Format(DateValue, "yyyymmddhhnnss") & "_同名格納" & ".jpg"
End If
FileCopy FilePath, Target
End Sub

Private Sub ReNewName_11_Click()
Dim ResultRename, FilePath, Target, TargetFolder, FileName As String
Dim DateValue As String

' 選択項目入力
ckRename = MsgBox("リネーム格納行います。", vbYesNo)

If (ckRename = vbYes) Then
Else
Exit Sub
End If

On Error Resume Next ' エラー時は強制で次に以降
DateValue = Date


'ファイル元パスがない場合終了
FileName = ckPhotoPath_1
FilePath = ckFolder.Folder_1 & "\" & ckPhotoPath_11
ResultRename = ckFolder.Rename_11
If (FileName = "") Then
Exit Sub
End If
If (ResultRename = "") Then
Exit Sub
End If
If (Right(ResultRename, 4) <> ".jpg") Then
MsgBox "拡張子がjpgではありません"
Exit Sub
End If
'フォルダ格納設定⇒JPGで格納
Target = ckFolder.Folder_1 & "\" & ResultRename
If Dir(Target, vbDirectory) = "" Then
'フォルダ内に重複名がない場合ファイルがない場合そのまま作成
Else
'フォルダ内に重複名がある場合ファイル名に時間とタグをがない場合日時データを付与して複製保存
Target = TargetFolder & "\" & Range("k" & i) & "_" & Format(DateValue, "yyyymmddhhnnss") & "_同名格納" & ".jpg"
End If
FileCopy FilePath, Target
End Sub

Private Sub ReNewName_12_Click()
Dim ResultRename, FilePath, Target, TargetFolder, FileName As String
Dim DateValue As String

' 選択項目入力
ckRename = MsgBox("リネーム格納行います。", vbYesNo)

If (ckRename = vbYes) Then
Else
Exit Sub
End If

On Error Resume Next ' エラー時は強制で次に以降
DateValue = Date


'ファイル元パスがない場合終了
FileName = ckPhotoPath_1
FilePath = ckFolder.Folder_1 & "\" & ckPhotoPath_12
ResultRename = ckFolder.Rename_12
If (FileName = "") Then
Exit Sub
End If
If (ResultRename = "") Then
Exit Sub
End If
If (Right(ResultRename, 4) <> ".jpg") Then
MsgBox "拡張子がjpgではありません"
Exit Sub
End If
'フォルダ格納設定⇒JPGで格納
Target = ckFolder.Folder_1 & "\" & ResultRename
If Dir(Target, vbDirectory) = "" Then
'フォルダ内に重複名がない場合ファイルがない場合そのまま作成
Else
'フォルダ内に重複名がある場合ファイル名に時間とタグをがない場合日時データを付与して複製保存
Target = TargetFolder & "\" & Range("k" & i) & "_" & Format(DateValue, "yyyymmddhhnnss") & "_同名格納" & ".jpg"
End If
FileCopy FilePath, Target
End Sub

Private Sub UserForm_Click()

End Sub

Private Sub UserForm_Initialize()
ckFolder.CoWordReName_3 = 1
End Sub

 ====================================================

 

⇒写真Exif編集アプリver500(3)へ

 

国頭郡(1):美ら海水族館 2018/12/2

 ずっとサーバー設定だったのですが、気分を変えて沖縄旅行続き

 


V_20181202_114236_vHDR_On.mp4

沖縄美ら海水族館 - 沖縄の美ら海を、次の世代へ。-

定番と言っては何だが、美ら海水族館にも行ってきました。

 

撮影日:2018/12/1

撮影場所:国頭郡 (日本)

撮影者:taikobox

  1. 美ら海水族館

  2. 美ら海水族館(大水槽内)

  3. 美ら海水族館(小水槽内)

  4. 美ら海水族館(ミニ水槽内)

  5. 館内資料

  6. 水族館外

  7. 万座毛(水族館後に訪問)

 

大型のジンベイザメが実は狩猟者でなく、プランクトンを濾して食べるのは有名な話ですが、大型のエイやウバザメ、メガマウスなんかの巨大な魚も実は同じように進化しているのは興味深い話やった。

 

 

 

 

 


 

 

 

 

Python勉強(5):ここまでやってなんですが改めてさくらVPS初めからやり直し

さくらVPSにPython3インストール

 

Python3学習用のプラットホームとして、さくらVPSにPython3インストールできたのですが全体システム作成に難儀したので、「ネコでもわかる!さくらインターネットVPS講座」に従い、一気にインストールしなおします。

 

f:id:taikobox:20181207133631p:plain
入門ガイド|VPS(仮想専用サーバー)はさくらインターネット

 

内容は、ここでWordPress入れる+Python3をインストール入力になります。

 

1)OSインストール(CentOS7)+スタートアップスクリプト(LAMP)

 サーバーには重要な情報おいていないのでOSセットアップからやり直し。OSは、さくらVPS上で参考資料の多いCentOS7へ変更。Wordpressインストールするので、スタートアップスクリプトは、LAMPApache+MySQLPHP同時インストール)。

設定項目以下に記す。

f:id:taikobox:20181207135414p:plain

 

2)SSHクライアントソフトのインストール

 ちょうどパソコンも新調したので、SSHクライアントソフトもインストール(以前はTeraTerm使用)。今回はさくらVPSで進められているPuttyをインストール⇒起動してみる。

hdk の自作ソフトの紹介 | PuTTYjp

f:id:taikobox:20181207141201p:plain

Putty起動画面

3)OSのアップデート

 最初にインストールしたOSのアップデート

 上記画面より

    login as:設定したID

    root@******’s password:設定したID

  でログイン後、

      [root@******]#

  と出るので

     #yum update

  と入力すると

          ~

       アップデート内容出力

             ~

      Is this ok [y/d/N]:

  と出力されるので⇒yを押す⇒あとはひたすら待つ(状況に応じては結構長いです)

    Complete!

 完了出力確認して終了!

 

4)一般ユーザーの作成 & rootTeraTerm直接アクセスの禁止

↓一般ユーザーを追加、adduserコマンド⇒passwdコマンドで作成

  [root@******]#adduser User*****
  [root@******]# passwd User*****
  Changing password for user UserTaikobo.
  New password:
  Retype new password:
  passwd: all authentication tokens updated successfully.

↓作成後、ログインできることを確認したのち

  login as: User*****

  User*****@*******'s password:

  SAKURA Internet [Virtual Private Server SERVICE]

↓コマンド su - にてroot(管理者)に切り替え

  [User*****@*******]$ su -

  Password:
↓コマンド su - にてroot(管理者)に切り替えsshの設定ファイル保存
  [root@******* ~]# cd /etc/ssh

  [root@******* ~]# cp sshd_config sshd_config.old

Vimエディタを開いて編集<さくらVPSに標準装備>

  [root@******* ssh]# vim sshd_config

 

Vimエディタを開いて編集 

  49行目の

   PermitRootLogin yes⇒PermitRootLogin no

  ⇒rootによるログインする⇒しないの切替設定を行う

  ⇒Vimエディタを保存して終了

sshd再起動

 [root@******* ssh]# systemctl restart sshd.service

 

 編集内容詳細は以下参照

knowledge.sakura.ad.jp

SSHのポート番号を変更 – SSHサーバーの設定 – Linux入門
http://webkaru.net/linux/change-ssh-port/

ssh接続を鍵認証で行なう
http://www.tooyama.org/ssh-key.html

Linuxのコマンドを勉強しよう!!Linux初心者の基礎知識
http://www.linux-beginner.com/linux_command.html

 

4)Apacheの設定

すでにスタートアップ時にApacheインストール済みなので、ファイヤーウォール設定のみ行う

↓一般ユーザー⇒管理者切替後、”systemctl start httpd” Apache起動

 [root@******* ~]# systemctl start httpd

↓コマンド”firewall-cmd”でhttpとhttpsをpublic(ファイヤーウォールの解除)

 [root@******* ~]# firewall-cmd --add-service=http --zone=public --permanent
 Warning: ALREADY_ENABLED: http
 success
 [root@******* ~]# firewall-cmd --add-service=https --zone=public --permanent
 Warning: ALREADY_ENABLED: https
 success

 ↓直接アドレス打ち込みアクセスできること確認f:id:taikobox:20181208104040p:plain

 

 ↓コマンド”systemctl enable httpd”でHTTPサーバー常時起動

     [root@******* ~]# systemctl enable httpd

 

5)パーミッション(権限許可)の確認⇒変更

 ↓root(管理者)権限で⇒”cd /var/www”でwwwフォルダ移動⇒”ls -l”ファイル詳細表示
  [root@*******~]# cd /var/www
  [root@******* www]# ls -l
  total 0
  drwxr-xr-x 2 root root 6 Nov 5 10:47 cgi-bin 
  drwxr-xr-x 2 root root 6 Nov 5 10:47 html

 f:id:taikobox:20181208121243p:plain

権限

r=read(読み)

w=write(書き)

x=execute(実行)

 ↓新しく作った”User*****”にも権限許可

 [root@****** www]# cd /var/www
 [root@****** www]# chown apache:User****** html
 [root@****** www]# chmod 775 html

 *

 Wordpressから触ることも前提なので、下記のリンク内容そのまま利用します。

 

ネコでもわかる!さくらのVPS講座 ~第三回「Apacheをインストールしよう」 | さくらのナレッジ

ここに丁寧に説明あります

  ↓変更確認
  drwxrwxr-x 2 apache User****** 6 Nov 5 10:47 html

 

6)ドメイン取得

 ドメイン取得していないことに気が付いたので、取得。

 独自ドメイン取得・管理 – レンタルサーバーはさくらインターネット
https://www.sakura.ne.jp/domain/

  ここはサクッと「Kuccha-Ne.com」で作成確認

 

f:id:taikobox:20181208135202p:plain

 ↓ドメイン側のネームサーバー設定

【ドメイン設定】さくらインターネットで取得・管理中のドメインを利用 – さくらのサポート情報

f:id:taikobox:20181208230322p:plain

 

f:id:taikobox:20181208230638p:plain

ドメイン読込確認する
 

7)先にPython3インストールしておく

 ↓以下の内容に即て、Python3先にインストール
qiita.com

 

 ↓Pythonバージョン確認⇒Python2インストール済み確認

  [root@*****www]# rpm -qa | grep python
  libreport-python-2.1.11-42.el7.centos.x86_64

 ↓IUS のリポジトリyum に追加

      [root@*****www]# qyum -y install https://centos7.iuscommunity.org/ius-release.rpm

 ↓Python3.6.5インストール (拡張モジュール/必要な開発環境/pip コマンド込み)

   [root@*****www]#  yum -y install python36u python36u-devel python36u-pip

 

レポジトリ= repository(直訳:倉庫転じて以下の意味)

情報工学において、仕様・デザイン・ソースコード・テスト情報・インシデント情報など、システムの開発プロジェクトに関連するデータの一元的な貯蔵庫を意味する。日本語レポジトリと表記される場合もある。一種のデータベースであり、ソフトウェア開発および保守における各工程の様々な情報を一元管理する。IUSはレポジトリの一つ

 

pipとは⇒Pythonのパッケージを管理するためのツール

 

yum? とは rpmとは?⇒パッケージの統合管理システム

yumYellowdog Updater Modified

rpmRed Hat Package Manager(レッドハット社作成のため)

qiita.com

 

8)phpMyAdminもインストール

 初期状態で、データベースはインストール済みなので、ブラウザからデータベース操作できるphpMyAdminツールもインストール。

ネコでもわかる!さくらのVPS講座 ~第五回「phpMyAdminを導入しよう」 | さくらのナレッジ

  ↓root権限でphpMyAdminインストール

   [root@****** ]# yum install --enablerepo=remi,remi-php71 phpMyAdmin

  ↓root権限でphpMyAdminの設定変更のためバックアップしてVim起動

  [root@****** ]# cd /etc/httpd/conf.d/
  [root@****** ]# cp phpMyAdmin.conf phpMyAdmin.conf.old
  [root@****** ]# vim phpMyAdmin.conf

 ↓Vimエディタで16行目付近を編集

  #Require local
  Require all granted

f:id:taikobox:20181208134609p:plain

何か間違えたみたいなので確認⇒後回し
 

9)HTML/PHPの動作確認 ドメイン手続き待っている間に

 PHPはスタートアップ時点でインストールされているので動作確認のみ。

 アップデート用のSFTPソフト「RLogin」を準備⇒index.php作成し「Hollow World」

 出力用ミニプログラムを準備⇒アップロードして動作確認。

 (改め知ったことだがFTPって今はあまり使わないんですね・・・) 

 

⇒続き

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

「食っちゃ寝システム第一弾」(3):写真Exif編集アプリver500(1)

「食っちゃ寝システム第一弾」(3):中間報告

ついぞサボって、沖縄に行ってしまいました^^

美ら海水族館

1.食っちゃ寝システムに向けて

「食っちゃ寝システム第一弾」に関連して、活動したこと...

 ・・・あまり進んでないです。

なんか、ひたすらVBAを組んでいたばっかりでした。ただそこでいろいろと身に着けたことがあるので備忘録として記録します

 

2.作成したもの備忘録

この間、大量に撮った写真を自動で整理できなかと思いVBA組んだ内容整理します。

(将来的にはPythonで一元化予定)

 

①写真を自動分別⇒リスト作成する

写真からExif情報を読み出し、その内容からフォルダ作成⇒ファイルリネーム⇒リサイズ⇒Exif編集行うもの作りました。将来的にはPythonでプログラム部分は作成し、エクセルに流し込む形で作り直しとします。(いろんな機能付加しましたが、今回はGPS情報用見出しから⇒リスト作成まで)

 

 <事前準備>
Exif情報読込には、以下のサイトのクラスモジュールを拝借しインポート。

Excel(VBA)でJPGファイルのExif情報を読み込む – FRONT

     ↓クラスモジュールとしてインポート

     

 

②縮小には「縮小専用」をShellオブジェクト⇒コマンドラインから読出す形で対応。そのため同フォルダに縮小専用.exeを入れます。

www.accessclub.jp


i-section.net

Exif情報についての学習

Exchangeable image file format(エクスチェンジャブル・イメージ・ファイル・フォーマット)は、富士フイルムが開発し、当時の日本電子工業振興協会 (JEIDA)で規格化された、写真用のメタデータを含む画像ファイルフォーマット。デジタルカメラの画像の保存に使われる。略称はExifで「エグジフ」(もしくは「イグジフ」)。

カメラの機種や撮影時の条件情報を画像に埋め込んでいて、ビューワやフォトレタッチソフトなどで応用することができる。Exif2.2ではExif Printという規格を組み込んでおり、撮影時の条件情報を元に自動的に最適化を行って、的確な状態でプリント出力を可能にしている。また撮影者や著作権情報、コメントなど付随することが出来る。

 

Exifのタグ一覧(以下参照)

けんしのページ - Exifファイルフォーマット -

今回は、限定的な情報の読込のみとクラスモジュールがあるので特別タグを覚える必要はありませんでしたが。次のステップでExif編集する場合必要になります。

VBAからコマンドライン操作

VBAから、値を渡して、他のアプリ開いて使用することができます。

 

 

qiita.com

vbabeginner.net

1)プログラムの動作説明

<リスト作成部分のコード>


Pythonで書くとき再整理します

===========================================

 

 

Public ckCurrentRow As Long
Public pkupFolder As String
Public pkupPath As String
Sub フォルダ内のファイル確認()

'画像確認用のマクロです。

Dim SrcName As String, ReExif, i, FolderPath, ckCurrentRow
Dim pkupPath As String
Dim pkupJpegFile, ctFile, IntoPath, IntoPicture

 

i = ActiveCell.Row

If (Range("K" & i) = "" Or i < 10) Then
i = 10
Else
If (Range("J" & i) = "") Then
MsgBox "フォルダ名が不正です"
Exit Sub
End If
End If


'データの格納

ckFolder.Folder_1 = ThisWorkbook.Path & Range("J8") & Range("J" & i)

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_3 = ctFile
End If
'読み込みデータの初期化
ckFolder.ckPhotoPath_1 = ""
ckFolder.ckPhotoPath_2 = ""
ckFolder.ckPhotoPath_3 = ""
ckFolder.ckPhotoPath_4 = ""
ckFolder.ckPhotoPath_5 = ""
ckFolder.ckPhotoPath_6 = ""
ckFolder.ckPhotoPath_7 = ""
ckFolder.ckPhotoPath_8 = ""
ckFolder.ckPhotoPath_9 = ""
ckFolder.ckPhotoPath_10 = ""
ckFolder.ckPhotoPath_11 = ""
ckFolder.ckPhotoPath_12 = ""

ckFolder.Rename_1 = ""
ckFolder.Rename_2 = ""
ckFolder.Rename_3 = ""
ckFolder.Rename_4 = ""
ckFolder.Rename_5 = ""
ckFolder.Rename_6 = ""
ckFolder.Rename_7 = ""
ckFolder.Rename_8 = ""
ckFolder.Rename_9 = ""
ckFolder.Rename_10 = ""
ckFolder.Rename_11 = ""
ckFolder.Rename_12 = ""

ckFolder.ckPhotoImage_1.Picture = LoadPicture("")
ckFolder.ckPhotoImage_2.Picture = LoadPicture("")
ckFolder.ckPhotoImage_3.Picture = LoadPicture("")
ckFolder.ckPhotoImage_4.Picture = LoadPicture("")
ckFolder.ckPhotoImage_5.Picture = LoadPicture("")
ckFolder.ckPhotoImage_6.Picture = LoadPicture("")
ckFolder.ckPhotoImage_7.Picture = LoadPicture("")
ckFolder.ckPhotoImage_8.Picture = LoadPicture("")
ckFolder.ckPhotoImage_9.Picture = LoadPicture("")
ckFolder.ckPhotoImage_10.Picture = LoadPicture("")
ckFolder.ckPhotoImage_11.Picture = LoadPicture("")
ckFolder.ckPhotoImage_12.Picture = LoadPicture("")

ckFolder.ckConfirm_1 = False
ckFolder.ckConfirm_2 = False
ckFolder.ckConfirm_3 = False
ckFolder.ckConfirm_4 = False
ckFolder.ckConfirm_5 = False
ckFolder.ckConfirm_6 = False
ckFolder.ckConfirm_7 = False
ckFolder.ckConfirm_8 = False
ckFolder.ckConfirm_9 = False
ckFolder.ckConfirm_10 = False
ckFolder.ckConfirm_11 = False
ckFolder.ckConfirm_12 = False


ckFolder.Show


End Sub

Sub フォルダ内写真データ取込み()
Dim ckend, ckCancel, pkupFolder As String

'オートフィルタ絞込解除
With ActiveSheet
If .FilterMode Then .ShowAllData
End With


'初期値設定 初期値は最終行 ただし10より小さい値の場合 10から
ckCurrentRow = Cells(Rows.Count, 2).End(xlUp).Row
If (ckCurrentRow < 9) Then
ckCurrentRow = 9
Else
End If

'フォルダ名初期化
pkupFolder = ""
ckend = MsgBox("元写真フォルダ読込", vbYesNoCancel)
If (ckend = vbYes) Then
'フォルダ名取込み
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
pkupFolder = .SelectedItems(1)
End If
End With
'フォルダ内の写真読込
Call フォルダ内Jpeg読込(pkupFolder)
Call 入力準備 '事前準備
Call 地域区分 '事前準備
ElseIf (ckend = vbNo) Then
MsgBox "既存リストの更新します"
If (Range("B10") = "") Then
Exit Sub
Else
Call 入力準備 '事前準備
Call 地域区分 '事前準備
End If
ElseIf (ckend = vbCancel) Then
End If

ckend = MsgBox("ファイルリネーム&フォルダー格納", vbYesNoCancel)
If (ckend = vbYes) Then
Call 写真リネーム格納 '実際のリネーム格納
ElseIf (ckend = vbNo) Then
Else
ckCancel = MsgBox("リストデータを削除してやり直します。", vbYesNo)
If (ckCancel = vbYes) Then
Range("A10:M10").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
Else
Exit Sub
End If
End If

End Sub

Sub フォルダ内Jpeg読込(pkupFolder As String)
Dim pkupPath As String
Dim pkupJpegFile
pkupPath = ""
pkupJpegFile = ""
pkupJpegFile = Dir(pkupFolder & "\*.Jpg")
Do While pkupJpegFile <> ""
ckCurrentRow = ckCurrentRow + 1
Cells(ckCurrentRow, 2) = pkupFolder & "\" & pkupJpegFile
pkupJpegFile = Dir()
Loop
pkupJpegFile = Dir(pkupFolder & "\*.Jpeg")
Do While pkupJpegFile <> ""
ckCurrentRow = ckCurrentRow + 1
Cells(ckCurrentRow, 2) = pkupFolder & "\" & pkupJpegFile
pkupJpegFile = Dir()
Loop
End Sub

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
Sub 地域区分()
Dim h, i, j, ctArea As Long

Dim ckLatGap, ckLonGap
Dim pkupLat, pkupLon, TmpLat, TmpLon, ckFlag
Dim nameAreaLat, stArea(0 To 2000, 1 To 3) 'stArea(1 To 100, 1 To 3)=基準エリア
Dim newFolder, fPath As String

'固定値入力
ckLatGap = Range("H2")
ckLonGap = Range("H3")
nameArea = Range("H8")
nameTerm = Range("E2")

'親フォルダ確認⇒なければ作成
If Dir(ThisWorkbook.Path & Range("J8"), vbDirectory) = "" Then
MkDir ThisWorkbook.Path & Range("J8")
Else
End If

'初期設定
TmpLatGap = ckLatGap '仮の中心緯度<絶対値>
TmpLonGap = ckLonGap '仮の中心経度<絶対値>
ctArea = 1
stArea(0, 1) = nameArea_0
stArea(0, 2) = ckLatGap
stArea(0, 3) = ckLonGap

 

For i = 10 To 20000

FilePath = Range("B" & i)
If (FilePath = "") Then
Exit For
End If

If (Range("E" & i) = "" Or Range("F" & i) = "") Then '"地域無"はスキップ

Else

pkupLat = Range("E" & i)
pkupLon = Range("F" & i)


'なければ過去分中から検索⇒それでもなければ新しいエリア作成
ckFlag = 0
For j = 0 To ctArea
TmpLatGap = Abs(pkupLat - stArea(j, 2)) '差分の絶対値
TmpLonGap = Abs(pkupLon - stArea(j, 3)) '差分の絶対値
If (TmpLatGap <= ckLatGap And TmpLonGap <= ckLatGap) Then 'エリア内にいる場合値入力ない場合新しいエリア作成,ckFlag=1でエリアあり判定
Range("H" & i) = stArea(j, 1)
ckFlag = 1
Exit For
End If
Next j
' ckFlag=0⇒新しいエリア作成
If (ckFlag = 0) Then
ctArea = ctArea + 1

'緯度経度データからエリア作成⇒指定中心位置誤差範囲小数2桁間で表示
If (pkupLat >= 0) Then
nameAreaLat = "N" & Int(Abs(pkupLat)) & "@" & Int*1 & "@" & Int*2 & "@" & Int*3 & "@" & Int*4 - Len(Replace(Range("J" & i), "\", ""))
If (ctFolderLyer > 2) Then
Exit Sub
End If

'フォルダ無い場合作成
'2層目フォルダ確認
ckFolder = Mid(Range("J" & i), 2)
If (ctFolderLyer = 1) Then
ckFolder1 = ckFolder
If Dir(ThisWorkbook.Path & Range("J8") & "\" & ckFolder1, vbDirectory) = "" Then
MkDir ThisWorkbook.Path & Range("J8") & "\" & ckFolder1
End If
ElseIf (ctFolderLyer = 2) Then
ckFolder1 = Left(ckFolder, InStr(ckFolder, "\") - 1)
ckFolder2 = Replace(Range("J" & i), "\" & ckFolder1 & "\", "")
'3層目フォルダ確認
If Dir(ThisWorkbook.Path & Range("J8") & "\" & ckFolder1, vbDirectory) = "" Then
MkDir ThisWorkbook.Path & Range("J8") & "\" & ckFolder1
End If
If Dir(ThisWorkbook.Path & Range("J8") & "\" & ckFolder1 & "\" & ckFolder2, vbDirectory) = "" Then
MkDir ThisWorkbook.Path & Range("J8") & "\" & ckFolder1 & "\" & ckFolder2
End If
End If

'フォルダ格納設定⇒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 If
'確認のマーカー及びリンクの作成
Range("A" & i) = "●"
Range("I" & i) = "★"
ActiveSheet.Hyperlinks.Add Anchor:=Range("I" & i), Address:=TargetFolder

Next i


'罫線を引き直す
If (Range("B10") = "") Then
Else

Range("A9:L9").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Borders.LineStyle = xlContinuous
End If


'写真リサイズ
If (ckResize = "有") Then
Call 写真データリサイズ
End If

End Sub

 

 ====================================================

 

⇒写真Exif編集アプリver500(2)へ

 

*1:Abs(pkupLat) - Int(Abs(pkupLat))) * 100)
ElseIf (pkupLat < 0) Then
nameAreaLat = "S" & Int(Abs(pkupLat

*2:Abs(pkupLat) - Int(Abs(pkupLat))) * 100)
End If
If (pkupLon >= 0) Then
nameAreaLon = "E" & Int(Abs(pkupLon

*3:Abs(pkupLon) - Int(Abs(pkupLon))) * 100)
ElseIf (pkupLon < 0) Then
nameAreaLon = "W" & Int(Abs(pkupLon

*4:Abs(pkupLon) - Int(Abs(pkupLon))) * 100)
End If
stArea(ctArea, 1) = nameAreaLat & nameAreaLon
stArea(ctArea, 2) = pkupLat
stArea(ctArea, 3) = pkupLat
Range("H" & i) = nameAreaLat & nameAreaLon
End If
End If

'仮フォルダ名格納
If (nameTerm = "年") Then
Range("J" & i) = "\" & Left(Range("G" & i), 4) & "\" & Range("H" & i)
ElseIf (nameTerm = "月") Then
Range("J" & i) = "\" & Left(Range("G" & i), 6) & "\" & Range("H" & i)
Else
Range("J" & i) = "\" & Range("G" & i) & "\" & Range("H" & i)
End If

Next i

End Sub


Sub 写真リネーム格納()
Dim i, ctFolderLyer As Long
Dim ckResize, ckRename, ckStroged, ckFolder As String
Dim ResultRename, FilePath, Target, TargetFolder, FolderName As String
Dim DateValue As String

' 選択項目入力
ckRename = MsgBox("リネーム格納行います。", vbYesNo)
ckResize = Range("E4")

If (ckRename = vbYes) Then
Else
Exit Sub
End If

On Error Resume Next ' エラー時は強制で次に以降
DateValue = Date

'親フォルダ確認(1層目),フォルダ無い場合直下に作成
If (Range("J8") = "") Then
'親フォルダない場合、無しのまま作成⇒もし"\"が先頭にない場合、\を追加
ElseIf (Left(Range("J8"), 1) <> "\") Then
Range("J8") = "\" & Range("J8")
Else
End If
If Dir(ThisWorkbook.Path & Range("J8"), vbDirectory) = "" Then
MkDir ThisWorkbook.Path & Range("J8")
Else
End If

For i = 10 To 20000
'ファイル元パスがない場合終了
FilePath = Range("B" & i)
If (FilePath = "") Then
Exit For
End If
'ファイルの保存先ファイル名がない場合及び確認にチェックがついている場合はスキップ
ckStroged = Range("A" & i)
ResultRename = Range("K" & i)
If (ckStroged = "●" Or ResultRename = "") Then
'リネームコピーせずにスキップ
Else
'フォルダ名に"\"ない場合追記
FolderName = Range("J" & i)
If (Left(FolderName, 1) <> "\") Then
FolderName = "\" & FolderName
End If
'\\の場合は\へ
Range("J" & i) = Replace(FolderName, "\\", "\")

TargetFolder = ThisWorkbook.Path & Range("J8") & Range("J" & i)
'フォルダがない場合直下を格納場所に指定 三層まで \⇒3つ不可
ctFolderLyer = Len(Range("J" & i

南城市(1):久高島 2018/12/1

 

今回の沖縄旅行で

 祝!! 日本47全都道府県制覇!!

 となったわけだが、とりあえず沖縄の神様に挨拶にということで「久高島」に訪問してきました。

 

www.city.nanjo.okinawa.jp

琉球開びゃくの祖アマミキヨが天から降りて最初につくったとされている島で、五穀発祥の地、神の島

 

撮影日:2018/12/1

撮影場所:南城市(日本)

撮影者:taikobox

  1. 南城市観光地図

     

  2. 高速船

  3. 海の中(普通にサンゴがいます)

    f:id:taikobox:20181206211739j:plain

  4. 貸自転車(久高島は自転車で3時間もあれば全部回れます)

  5. 猫島もいっぱいです

    f:id:taikobox:20181206212234p:plain

  6. 聖地ですが、ごっつい携帯基地局アンテナあります

  7. 自転車(途中から天気も良くなりました)

  8. ハビャーン(琉球開闢の祖が降り立った地です)

    f:id:taikobox:20181206212805p:plain

  9. ウパーマ浜:砂浜なんですが・・・、聖地なんで遊泳は禁止です

    f:id:taikobox:20181206213732p:plain

  10. イシキ浜:ここに五穀が届き琉球の農業のもとになったと・・・
  11. イラブ―酒:結構おいしいです

    f:id:taikobox:20181206215202p:plain

  12. 帰りのフェリーから 

 

久高島は、「ニライカナイ」という異界(常世の国に近いかな?)に一番近い島とされており、今でも聖地として入ってはいけない「フボー御嶽」があります。島自体が聖地なのでもし訪れるなら、襟を正していくのがいいかと。

沖縄の異界(楽土)「ニライカナイ」は、生命が来て、生命がが帰る、地下にある国と考えると黄泉の国に近い印象なのですが。ほかでも書籍読んで調べてみます。

ちなみに「ニライカナイ」は、よく音楽や小説、漫画にも出て来ます。有名なところでは、モスラ2 海底の大決戦で名前が出てくるし、そのまま、ニライカナイって曲も複数のアーチストから出ているくらいなんですが…。

なんか、ぶっ飛び具合でやけに印象に残っているのは、

ニライカナイ」(岡田 芽武)の漫画が印象的で…(笑) 

 

クトゥルフテイストを織り交ぜながら「人間」と「神様」がガチンコバトルを繰り広げるという、熱のある面白漫画だった記憶があります。(これしか説明しようがないもの(笑))

ではでは引き続き沖縄写真で

 

 

 

 


 

 

 

 

那覇市(1):那覇空港~首里城 2018/11/30

この前、沖縄に行ってきました

第14回目として、沖縄の写真上げていきます。

今回の沖縄旅行で

 日本 47全都道府県制覇!!

 を果たした旅行でした。

いや~長かった…。気が付いたら、もうそろそろ46歳なもんで…

 

行くことしか考えてなかったので、現地で、やること探し、宿探しと割とグタグタではありました。しかしながら、「那覇ラソン」でにぎやかな時、首里城の漆塗りが終わった翌日に訪問できたこと、天気が良かったことなど運に恵まれた旅行になりました。

*ちなみにゆいレールで一日乗車券買うと、首里城入場が団体料金では入れるようになります。うまく利用してください。

 

oki-park.jp

 

撮影日:2018/11/30

撮影場所:那覇市(日本)

撮影者:taikobox

  1. 那覇空港駅(日本最西端の駅)

    f:id:taikobox:20181205224747p:plain

  2. 赤嶺駅(日本最南端の駅)

    f:id:taikobox:20181205225019p:plain

  3. 首里城前ローソン

  4. 首里城内地図

  5. 首里城入口(歓會門)

  6. 石垣の積み方が外側と内側で違います

    f:id:taikobox:20181205225716p:plain

  7. 首里城からの景色(パノラマ)
  8. 首里城内本殿地図
  9. 首里城南殿
  10. 玉座2F
  11. 首里城模型

  12. 首里城の基礎(実はこの部分が世界遺産です)

    f:id:taikobox:20181205231113p:plain

  13. 玉座1F

    f:id:taikobox:20181205232259p:plain

  14. 首里城

  15. 首里城 (夜)

    f:id:taikobox:20181205233051p:plain

 

首里城といえば、「花の慶次」の漫画思い出してしまいます。

 

hananokeiji.jp

 

 

 


 

 

 

 

メルボルン(1):メルボルン博物館 2011/6/2

 

 過去の棚卸として、旅行にいて撮りためた写真もあげていきます。

第13回目の続き、キングスキャニオンに続きオーストラリアのメルボルンです。

お世話になった英語の先生に会いに行くのが第一目的で訪問しました。先生の方は日本語の婚約者ができたせいで日本語の方が達者になっていましたが…(笑)

ちなみに「食っちゃ寝システム」は着々と進行してないです(笑)

ただその合間にも、VBAではいろいろ作ってしまったのと、VBAからのコマンドライン操作や、ExifToolなど新しいこといろいろ覚えたのでまた忘れないないうちに出来上がったところで備忘録記載します。(多分27日までには)

 

 

 

撮影日:2011/6/2

撮影場所:メルボルン(オーストラリア)

撮影者:taikobox

    1. メルボルン博物館

       

      f:id:taikobox:20181125232928j:plain

       

    2. 入口

      f:id:taikobox:20181125233350j:plain

    3. エントランス

      f:id:taikobox:20181125233441j:plain

    4. 飛行機f:id:taikobox:20181125233719j:plain

       

    5. 大型恐竜

      f:id:taikobox:20181125233838j:plain

       

    6. 球状花崗岩f:id:taikobox:20181125234039p:plain

    7. 大型哺乳類(クジラ)

      f:id:taikobox:20181125234437j:plain

 

思えば、世界一周中、様々な博物館周りましたが。博物館周ろうと決めたのは、このメルボルン博物館に入った時、だったたと思います。規模的なものに驚いたの確かですが、比較的、自由に資料を触らせてもらえたことに感動したのを覚えています。これは、割と大英博物館スミソニアン博物館も同じように学ぶ上で本物を触らさせてくれるスタンスが一緒でした。とはいっても触ってはいけないものや触る事で劣化するものもあるのでなんでもってわけにもいきませんが、そこで触らない選択をすることも含め、触ることのできる選択肢を与えているとこがすごく違うと感じたのは確かです。


jp.visitmelbourne.com

 

 

 

 

 

 

「食っちゃ寝システム第一弾」(2):中間報告と作成物

「食っちゃ寝システム第一弾」(2):中間報告

1.食っちゃ寝システムに向けて

「食っちゃ寝システム第一弾」に関連して、活動したこと。

  1. Python3環境の構築
  2. はてなブログのアップデート
  3. VBAでマクロ作成

 ・・・そして仕事を辞めたこと(笑)

特に、辞める間際に仕事に関係して作業効率化のVBAマクロを立続けに作りました。もちろん食っちゃ寝の精神は忘れず(笑)。改めて作ってみると、いろんな発見があったので忘れないうちに記録してます。

 

 

2.作成したもの備忘録

 

①webデータベース上の入力値を読込判定するマクロ

画面や項目は、独自のデータベース内容に絡むので内容そのままの転載はしませんが・・・

 

独自のWebデータベースにアクセスするため、ページにそのままのアクセスが難しく

どのようにしたらと考えましたが・・・

  開いているのを読み込めばいいやん!!

ってことで

セキュリティを解除したページを直接読み込んで取込む方式で解決しました。

 

 <事前準備>

IE操作するため、ツール⇒参照設定で

f:id:taikobox:20181119190833p:plain


Microsoft HTML Object library

Microsoft Internet Controls

 を使用します。

 

[参照設定] ダイアログ ボックス | Microsoft Docs

 

www.atmarkit.co.jp

 

開いているエクスプローラーの判定⇒ページ上のボタンクリックするまでの処理を自動で行うために作成しました

以下その処理の順番です。

 

1)インターネットエクスプローラー確認

 Set shl = CreateObject("Shell.Application")'①シェルオブジェクトセットし開いているエクスプローラー確認

 ~

2)ページ判定

 For i = 0 To objIE.document.getElementsByTagName("h3").Length - 1 'h3要素を順次確認

 ~

3)指定ページにジャンプするため画面上のボタンをクリックする処理

 If (txtFlag = False And PageFlag = True And ckWAVEtype = "【物件ページ】") Then '該当ページがあるかの判定

 ~

 

===========================================

Sub ImportIE(ByVal ckWAVEtype As String) ', ByRef a As String

Dim shl As Object 'シェルオブジェクト生成
Dim htmlDoc As HTMLDocument
Dim win As Object, getFlag, txtFlag, PageFlag As Boolean
Dim targetTitle As String 'タイトル確認
Dim objTag As Object '指定ボタン押す
Dim objLink As Object '指定リンクを押す

Set shl = CreateObject("Shell.Application")'①シェルオブジェクトセットし開いているエクスプローラー確認

targetTitle = "*******" 'Webサイトのタイトル

For Each win In shl.Windows '起動中のウィンドウを順次確認

'IEエクスプローラがシェルで取得されるため、IEのみ処理

If TypeName(win.document) = "HTMLDocument" Then 'HTML形式の時読込

If win.document.Title = targetTitle Then 'Webサイトのタイトルがある場合

Dim objIE As New InternetExplorer
Set objIE = win 'Webサイトのタイトルがある場合 obiIEオブジェクトに格納

getFlag = True '正しく取得できたフラグをセット

Exit For

End If
End If

Next

If getFlag = False Then
MsgBox "目的のWebページが開かれていません。⇒IE開きます", vbExclamation
Call IEOpen
Exit Sub
End If

'②ページチェック
'HTMLタグがh3要素内の文言を判定し、対象のページか判断する
For i = 0 To objIE.document.getElementsByTagName("h3").Length - 1 'h3要素を順次確認
'別で指定されている変数ckWAVEtypeあればtxtFlag⇒true
If (objIE.document.getElementsByTagName("h3")(i).innerText = ckWAVEtype) Then
txtFlag = True
Exit For
'「判定用文言」あればがあればPageFlag⇒true
ElseIf (objIE.document.getElementsByTagName("h3")(i).innerText = "判定用文言") Then
PageFlag = True
Else
End If

Next i

'HTMLタグがh3要素が「進捗」で「***」移動してない場合⇒「Web上のボタン」をクリックして一度スクレイピングの処理を抜ける
'各種登録の場合、データのみクリップボードに格納し、物件詳細に戻る。例:「Web上のボタン」⇒詳細へ、もどる

If (txtFlag = False And PageFlag = True And ckWAVEtype = "【物件ページ】") Then '該当ページがあるかの判定
'送信(submit)をクリック
For Each objTag In objIE.document.getElementsByTagName("input") 'ネームタグに"input"あるかの判定

If InStr(objTag.outerHTML, "Web上のボタン") > 0 Then 'クリックするボタンがあるかの判定

'送信ボタンクリック
objTag.Click

'ループ脱出⇒タイミングよってはログアウトしているときがあるので一度確認必要
MsgBox ("ページ切り替えます。切り替わったページ確認して下さい")
GoTo ExitHTMLscraping


End If
Next
Else
End If


'<中略>


ExitHTMLscraping:
'エラー及び処理中断時のスキップ場所
'オブジェクト開放
Set shl = Nothing
Set win = Nothing
Set htmlDoc = Nothing


End Sub

 

 ====================================================

 

画面上のボタンをクリックして、次ページに自動で移動は

objTag.Click

で行っていますが。

submit コマンドでも同じこと可能です。

ただしClickコマンドの方が何かと融通が利くと思いますのでこちらを採用。

 

ちなみに下記のサイトにVBAでのIE操作が細かく記載されており

非常にありがたく参照させていただきました

www.vba-ie.net

 

続きは別ページで

ウルル・カタジュタ(3):キングスキャニオン1 2011/5/31

 

 過去の棚卸として、旅行にいて撮りためた写真もあげていきます。

第12回目の続き、キングスキャニオンです。世界の中心で、愛をさけぶ』の舞台の一つでもあります

 

 

www.tbs.co.jp

 

撮影日:2011/5/31

撮影場所:キングスキャニオン(オーストラリア)

撮影者:taikobox

  1. キングスキャニオン1

    f:id:taikobox:20181115052655j:plain

  2. キングスキャニオン2

    f:id:taikobox:20181115052613j:plain

  3. 崖っぷちf:id:taikobox:20181115052754j:plain

  4. 頑張って生えている

    f:id:taikobox:20181115052531j:plain

  5. 貴重な水場

    f:id:taikobox:20181115052952j:plain

  6. 生態系

    f:id:taikobox:20181115053042j:plain

  7. f:id:taikobox:20181115053458j:plain

  8. トレッキング

    f:id:taikobox:20181115053244j:plain

  9. 人生崖っぷち(笑)

    f:id:taikobox:20181115053342j:plain

  10. 今回のメンバー

    f:id:taikobox:20181115054015p:plain

 

 キングスキャニオン公園

 

 

www.australia.com